C
C
C
SUBROUTINE ADDKBB(LINE)
C =======================
C
c Add line to keyboard buffer
C
IMPLICIT NONE
C
CHARACTER*(*) LINE
C
C&&*&& include ../inc/mxdkbb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdkbb.h
C---- START of include file mxdkbb.h
C
c
c********** mxdkbb *************
c
c Keyboard input buffer
c
c kbdbuf(0:maxkbb-1) rotating line buffer
c ip1kbb read pointer (= -1 is no lines to read)
c ip2kbb write pointer
c markbb mark point (= -1 if unset)
c
integer maxkbb
parameter (maxkbb = 10)
character*80 kbdbuf(0:maxkbb-1)
integer ip1kbb, ip2kbb, markbb
c
common /kbblin/ kbdbuf
common /kbbptr/ ip1kbb, ip2kbb, markbb
c
save /kbblin/, /kbbptr/
c
C&&*&& end_include ../inc/mxdkbb.f
C
C
KBDBUF(IP2KBB) = LINE
c Set pointer to read line if unset
IF (IP1KBB .LT. 0) THEN
IP1KBB = IP2KBB
ELSEIF (IP2KBB .EQ. IP1KBB) THEN
c Just overwritten next read line, so reset (increment) read pointer
IP1KBB = MOD(IP1KBB+1,MAXKBB)
ENDIF
c Update write pointer
IP2KBB = MOD(IP2KBB+1, MAXKBB)
C
RETURN
END
SUBROUTINE ADDSPOT(IXP,IYP,IMAGE,NXPIX,NYPIX,
+ IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,ISTAT)
C ============================================================
C
IMPLICIT NONE
C
C---- To allow manual addition of spots to the spot list, selected by
C the mouse cursor.
C
C IXP,IYP Cursor position (image pixels)
C IMAGE Image array
C NXPIX Size of image array in slow direction
C NYPIX Size of image array in fast direction
C IXSPWDTH Sise of spot in X direction
C IYSPWDTH Sise of spot in Y direction
C IXSPBOX Size of box to be extracted in X direction
C IYSPBOX Size of box to be extracted in Y direction
C ISTAT Error flag -1 if too many spots
C DEBUG(67)
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
INTEGER IXP,IYP,NXPIX,NYPIX,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ ISTAT
C
C ..
C .. Array Arguments ..
INTEGER*2 IMAGE(NYPIX,NXPIX)
C ..
C .. Local Scalars ..
INTEGER I,II,J,JJ,IXP2,IYP2,IXST,IXEND,IYST,IYEND,IOD,IHXSP,
+ IHYSP,IXMIN,IXMAX,IYMIN,IYMAX,IHX,IHY,IXSIZ,IYSIZ,
+ IMAX,JMAX,IODMAX,MODEDISP,NPREV
REAL SUM,SUMX,SUMY,XSP,YSP
C ..
C .. Local Arrays ..
INTEGER ISPBOX(MAXDIM,MAXDIM)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
INTEGER INTPXL
EXTERNAL INTPXL
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
IHX = IXSPBOX/2
IHY = IYSPBOX/2
C
C---- Set up limits for box to be extracted from IMAGE array
C
IXMIN = MAX(1,IXP-IHX)
IXMAX = MIN(NXPIX,IXP+IHX)
IYMIN = MAX(1,IYP-IHY)
IYMAX = MIN(NYPIX,IYP+IHY)
IXSIZ = IXMAX - IXMIN + 1
IYSIZ = IYMAX - IYMIN + 1
C
IMAX = 0
JMAX = 0
IODMAX = 0
II = 0
DO 20 I = IXMIN,IXMAX
II = II + 1
JJ = 0
DO 10 J = IYMIN,IYMAX
JJ = JJ + 1
IOD = INTPXL(IMAGE(J,I))
IF (IOD.GT.IODMAX) THEN
IMAX = II
JMAX = JJ
IODMAX = IOD
END IF
ISPBOX(JJ,II) = IOD
10 CONTINUE
20 CONTINUE
C
IF (DEBUG(67)) THEN
WRITE(IOUT,FMT=6000) IXMIN,IXMAX,IYMIN,IYMAX,IMAX,JMAX,IODMAX
IF (ONLINE) WRITE(ITOUT,FMT=6000) IXMIN,IXMAX,IYMIN,IYMAX,
+ IMAX,JMAX,IODMAX
6000 FORMAT(1X,'Limits of box in X',2I6,' in Y',2I6,/,1X,
+ 'Max counts at X=',I5,' Y=',I5,' with value',I8)
END IF
C
C---- Now find c. of g. of a box of size IXSPWDTH,IYSPWDTH centred on
C the maximum value
C
IHXSP = IXSPWDTH/2
IHYSP = IYSPWDTH/2
C
C---- Check box is within extracted box
C
IF (((IMAX-IHXSP).LT.1).OR.((IMAX+IHXSP).GT.IXSIZ)
+ .OR.((JMAX-IHYSP).LT.1).OR.((JMAX+IHYSP).GT.IYSIZ)) THEN
C
C---- Set up limits for new box to be extracted from IMAGE array
C
IXP2 = IXMIN + IMAX - 1
IYP2 = IYMIN + JMAX - 1
C
C----- If this box lies outside image array, reduce its size
C
IF ((IXP2 - IHX).LT.1) THEN
IHX = IXP2 - 1
ELSE IF ((IXP2 + IHX).GT.NXPIX) THEN
IHX = NXPIX - IXP2
ELSE IF ((IYP2 - IHY).LT.1) THEN
IHY = IYP2 - 1
ELSE IF ((IYP2 + IHY).GT.NYPIX) THEN
IHY = NYPIX - IYP2
END IF
IXMIN = IXP2 - IHX
IXMAX = IXP2 + IHX
IYMIN = IYP2 - IHY
IYMAX = IYP2 + IHY
IXSIZ = IXMAX - IXMIN + 1
IYSIZ = IYMAX - IYMIN + 1
C
IF (DEBUG(67)) THEN
WRITE(IOUT,FMT=6002) IXMIN,IXMAX,IYMIN,IYMAX
IF (ONLINE) WRITE(ITOUT,FMT=6002) IXMIN,IXMAX,IYMIN,IYMAX
6002 FORMAT(1X,'Extract a new box, new limits of box in X',
+ 2I6,' in Y',2I6)
END IF
IODMAX = 0
II = 0
DO 40 I = IXMIN,IXMAX
II = II + 1
JJ = 0
DO 30 J = IYMIN,IYMAX
JJ = JJ + 1
IOD = INTPXL(IMAGE(J,I))
IF (IOD.GT.IODMAX) THEN
IMAX = II
JMAX = JJ
IODMAX = IOD
END IF
ISPBOX(JJ,II) = IOD
30 CONTINUE
40 CONTINUE
C
END IF
C
C---- Now find the c. of g.
C
SUMX = 0
SUMY = 0
SUM = 0
IXST = IMAX - IHXSP
IXEND = IMAX + IHXSP
IYST = JMAX - IHYSP
IYEND = JMAX + IHYSP
C
C---- Try to trap failuers
C
IF ((IXST.LT.1).OR.(IYST.LT.1)) RETURN
DO 60 I = IXST,IXEND
DO 50 J = IYST,IYEND
IOD = ISPBOX(J,I)
SUMX = SUMX + REAL(I*IOD)
SUMY = SUMY + REAL(J*IOD)
SUM = SUM + REAL(IOD)
50 CONTINUE
60 CONTINUE
C
IF (SUM.GT.0) THEN
SUMX = SUMX/SUM
SUMY = SUMY/SUM
END IF
C
C---- Convert to mm, corrected for YSCAL
C
XSP = (SUMX + IXMIN - 1)*RAST
YSP = (SUMY + IYMIN - 1)*RAST/YSCAL
C
C---- Add this spot to the total. NSPT is initially the number found
C by the automatic search, but is incremented for manually added spots.
C
C
IF (NIMAG.EQ.1) THEN
NPREV = 0
ELSE
NPREV = IENDIMG(NIMAG-1)
END IF
C
IF (NPREV+NSPT.LT.NSPOTS) THEN
IF (ISTIMG(NIMAG).EQ.0) THEN
IF (NIMAG.EQ.1) THEN
ISTIMG(NIMAG) = 1
IENDIMG(NIMAG) = 0
ELSE
ISTIMG(NIMAG) = NPREV + 1
END IF
END IF
NSPT = NSPT + 1
XSPT(NPREV+NSPT) = XSP
YSPT(NPREV+NSPT) = YSP
ISPT(NPREV+NSPT) = SUM
ISDSPT(NPREV+NSPT) = MAX(NINT(0.001*SUM),1)
ISPT(NPREV+NSPT) = 1000*ISDSPT(NPREV+NSPT)
IENDIMG(NIMAG) = NPREV + NSPT
IF (DEBUG(67)) THEN
WRITE(IOUT,FMT=6010) SUMX,SUMY,SUM,XSP,YSP,NSPT,NIMAG
IF (ONLINE) WRITE(ITOUT,FMT=6010) SUMX,SUMY,SUM,XSP,YSP,
+ NSPT,NIMAG
6010 FORMAT(1X,'Centre of gravity',2F8.2,' Total intensity',F8.0,
+ /,1x,'mm coords',2F8.2,' added as spot number',I5,
+ ' on image',I3)
END IF
ELSE
ISTAT = -1
RETURN
END IF
C
C---- display this spot
C
MODEDISP = 1
CALL DSPSPT(MODEDISP)
END
SUBROUTINE ADJREF(IX,IY,IFLAG)
C
C---- Calculates the rotation, scale factor and translation required
C to superimpose the spots whose predicted and observed positions
C have been entered using the mouse and are stored in IX,IY in
C image pixels
C
C IX(4),IY(4) Coordinates of the 4 points
C IFLAG = 0 Calculated shift accepted for all images
C = 1 Calculated shift accepted for current image only
C = 2 Reject calculated shift (AND TRY AGAIN)
C
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER NPARM
PARAMETER (NPARM = 200)
C
C .. Scalar Arguments ..
INTEGER IFLAG
C
C .. ARRAY Arguments ..
INTEGER IX(4),IY(4)
C ..
C .. Local Scalars ..
REAL ANGLE,COSA,COSOM,DELX,DELY,DXCAL,DXOBS,DYCAL,DYOBS,OMEGA0,R,
+ RCOS,RSIN,SINA,SINOM,SPSI,SCDX,SCDY,SSINOM0,SCOSOM0,SXTOFRA,
+ CDX,CDY,SXCEN,SYCEN,DRSQ,X,X1,X2
INTEGER I,IER,IXP,IYP,IBUTTON,L,NDISP,MODE
CHARACTER LINE*80,LLINE*80,STR1*4
LOGICAL YES
C ..
C .. Local Arrays ..
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Subroutines ..
EXTERNAL MXDWIO,XDLF_POPUP_NOTICE,MXDCIO,DSPPRD
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN2,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
IFLAG = 0
MODE = 0
SXTOFRA = XTOFRA
SPSI = PSIPREC
SSINOM0 = SINOM0
SCOSOM0 = COSOM0
SXCEN = XCEN
SYCEN = YCEN
SCDX = CDX
SCDY = CDY
C
C---- Move coords so they are relative to direct beam position
C
DO 10 I = 1,4
IX(I) = IX(I) - XCEN*FACT
IY(I) = IY(I) - YCEN*FACT
10 CONTINUE
C
DXOBS = IX(2) - IX(4)
DYOBS = IY(2) - IY(4)
DXCAL = IX(1) - IX(3)
DYCAL = IY(1) - IY(3)
DRSQ = (DXCAL**2+DYCAL**2)
X1 = DXOBS*DXCAL+DYOBS*DYCAL
X2 = DYOBS*DXCAL-DXOBS*DYCAL
X = X1**2 + X2**2
C
IF ((DRSQ.LT.1.0E-5).OR.(X.LT.1.0E-5)) THEN
LINE = ' '
WRITE (LINE,FMT=6020)
6020 FORMAT (1X,'Points too close to allow adjustment')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE (LINE, 6022)
6022 FORMAT (1X, 'Do you want to try again ? (Y)')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LLINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LLINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LLINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
IFLAG = 2
RETURN
ELSE
CALL MXDCIO(1,0,0,0,0)
RETURN
END IF
END IF
C
RCOS = (DXOBS*DXCAL+DYOBS*DYCAL)/ DRSQ
RSIN = (DYOBS*DXCAL-DXOBS*DYCAL)/ DRSQ
R = SQRT(RCOS**2+RSIN**2)
XTOFRA = XTOFRA*R
COSA = RCOS/R
SINA = RSIN/R
ANGLE = ATAN2(RSIN,RCOS)*180.0/3.14159
C
C
COSOM = COSOM0*COSA - SINOM0*SINA
SINOM = COSOM0*SINA + SINOM0*COSA
SINOM0 = SINOM
COSOM0 = COSOM
OMEGA0 = ATAN2(SINOM0,COSOM0)*180.0/3.14159
C
C
C---- FACT converts image pixels back to 10micron units
C
DELX = (IY(1)*RSIN+IX(2)-IX(1)*RCOS)/FACT
XCEN = XCEN + DELX
DELY = (IY(2)-IY(1)*RCOS-IX(1)*RSIN)/FACT
YCEN = YCEN + DELY
WRITE (LINE,FMT=6000) R
6000 FORMAT(1X,'Scale factor =',F6.3)
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE,FMT=6002) ANGLE
6002 FORMAT (1X,'Rotation of calculated pattern=',F6.2,' Deg.')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE,FMT=6004) 0.01*DELX,0.01*DELY
6004 FORMAT (1X,'Shift in Centre =',2F6.1,'mm')
CALL MXDWIO(LINE, 2)
C
C
C---- Check for continuation
C
LINE = ' '
WRITE (LINE, 6018)
6018 FORMAT (1X, 'Do you wish to accept this ? (Y)')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LLINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LLINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LLINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
C
C---- Delete old prediction, put up new one
C
CALL MXDDVN(BOX_VEC)
CALL DSPPRD(NDISP,MODE)
ELSE
C
C---- Restore original values
C
XTOFRA = SXTOFRA
PSIPREC = SPSI
SINOM0 = SSINOM0
COSOM0 = SCOSOM0
XCEN = SXCEN
YCEN = SYCEN
CDX = SCDX
CDY = SCDY
END IF
C
C
C---- Apply to all images ?
C
LINE = ' '
WRITE (LINE, 6024)
6024 FORMAT (1X, 'Update beam coordinates for all images ? (Y)')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LLINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LLINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LLINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
IFLAG = 0
ELSE
IFLAG = 1
END IF
CALL MXDCIO(1,0,0,0,0)
END
C== ALIGN ==
C
SUBROUTINE ALIGN(JAXIS,IUNIQ)
C ============================
C
IMPLICIT NONE
C
C---- To determine the orientation of the real space axes wrt the laboratory
C frame and the rotation required to bring real space axes into the plane
C containing the rotation axis and the X-ray beam
C Used in STRATEGY option
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
C
C ..
C .. Local Scalars ..
INTEGER I,IAXIS,JAXIS,J,IUNIQ
REAL DTOR,ANGMIN,THETAMAX,THETAUNIQ,THADD,TRUANG
CHARACTER ABCSTR(3)*1, LINE*80
LOGICAL NOCUSP,NULINE,HIGHSYM
C ..
C .. Local Arrays ..
REAL AREAL(3),
+ BREAL(3),CREAL(3),AANG(3),BANG(3),CANG(3),ZANG(3),
+ ABCREAL(3,3),THETA(3),DELPHIL(3),ANGTOX(3)
C ..
C .. External Subroutines ..
EXTERNAL WINDIO,ALIGN2,MXDWIO
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C ..
C .. Equivalences ..
EQUIVALENCE (AREAL(1),ABCREAL(1,1)),(BREAL(1),ABCREAL(1,2)),
+ (CREAL(1),ABCREAL(1,3))
SAVE
C ..
C .. Data ..
DATA ABCSTR/'a','b','c'/
C ..
DTOR = ATAN(1.0)*4.0/180.0
NULINE = .TRUE.
C
CALL ALIGN2(DELPHI,AMAT,AREAL,BREAL,CREAL)
C
C---- Get angles with lab X,Y,Z axes
C
DO 20 I = 1,3
AANG(I) = ACOS(AREAL(I))/DTOR
BANG(I) = ACOS(BREAL(I))/DTOR
CANG(I) = ACOS(CREAL(I))/DTOR
DELPHIL(I) = DELPHI(I)
20 CONTINUE
C
C
WRITE(IOUT,FMT=6010) (AANG(I),I=1,3),(BANG(I),I=1,3),
+ (CANG(I), I=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6010) (AANG(I),I=1,3),
+ (BANG(I),I=1,3),(CANG(I), I=1,3)
6010 FORMAT(1X,'Angles between a axis and X,Y,Z axes',3F8.3/,
+ 1X,'Angles between b axis and X,Y,Z axes',3F8.3,/,
+ 1X,'Angles between c axis and X,Y,Z axes',3F8.3)
C
C---- Find axis closest to the rotation (Z) axis
C
ZANG(1) = ABS(MIN(AANG(3),180-AANG(3)))
ZANG(2) = ABS(MIN(BANG(3),180-BANG(3)))
ZANG(3) = ABS(MIN(CANG(3),180-CANG(3)))
C
ANGMIN = 200.0
DO 30 I = 1,3
IF (ZANG(I).LT.ANGMIN) THEN
ANGMIN = ZANG(I)
IAXIS = I
END IF
30 CONTINUE
C
WRITE(IOUT,FMT=6020) ABCSTR(IAXIS),ANGMIN
IF (ONLINE) WRITE(ITOUT,FMT=6020) ABCSTR(IAXIS),ANGMIN
6020 FORMAT(1X,'The ',A,' axis is closest to the rotation axis ',
+ '(angle',F6.2,')')
IROTAX = IAXIS
PHIROTAX = 2*(NINT(ANGMIN)/2)
C
C---- Find the actual angle, needed for orthorhombic choices
C
IF (IAXIS.EQ.1) THEN
TRUANG = AANG(3)
ELSE IF (IAXIS.EQ.2) THEN
TRUANG = BANG(3)
ELSE
TRUANG = CANG(3)
END IF
C
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6060) (AANG(I),I=1,3)
6060 FORMAT('Angles between a axis and X,Y,Z axes',3F8.3)
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6062) (BANG(I),I=1,3)
6062 FORMAT('Angles between b axis and X,Y,Z axes',3F8.3)
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6064) (CANG(I),I=1,3)
6064 FORMAT('Angles between c axis and X,Y,Z axes',3F8.3)
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6066) ABCSTR(IAXIS),ANGMIN
6066 FORMAT('The ',A,' axis is closest to the rotation axis ',
+ '(angle',F6.2,')')
CALL MXDWIO(LINE,1)
END IF
C
C---- Find rotation angle required to bring other axes into XZ plane
C
ANGMIN = 200.0
DO 40 I = 1,3
IF (I.EQ.IAXIS) GOTO 40
IF (ABCREAL(1,I).EQ.0.0) THEN
THETA(I) = 90.0
ELSE
THETA(I) = ATAN(-ABCREAL(2,I)/ABCREAL(1,I))/DTOR
END IF
IF (ABS(THETA(I)).LT.ANGMIN) THEN
ANGMIN = ABS(THETA(I))
JAXIS = I
END IF
WRITE(IOUT,FMT=6030) ABCSTR(I),THETA(I)
IF (ONLINE) WRITE(ITOUT,FMT=6030) ABCSTR(I),THETA(I)
6030 FORMAT(1X,'Rotation angle to get the ',A,' axis in XZ plane',
+ F8.2)
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6068) ABCSTR(I),THETA(I)
6068 FORMAT('Rotation angle to get the ',A,' axis in XZ plane',
+ F8.2)
CALL MXDWIO(LINE,1)
END IF
40 CONTINUE
C
C---- Rotation to get the principle axis in the YZ plane
C
IF (NLAUE.EQ.4) THEN
IUNIQ = 2
ELSE
IUNIQ = 3
END IF
C
IF (ABCREAL(1,IUNIQ).EQ.0.0) THEN
THETAUNIQ = 0.0
ELSE
IF (ABCREAL(2,IUNIQ).EQ.0.0) THEN
THETAUNIQ = 90.0
ELSE
THETAUNIQ = ATAN(ABCREAL(1,IUNIQ)/ABCREAL(2,IUNIQ))/DTOR
END IF
END IF
C
C---- Use THETAUNIQ for trigonal or higher symmetry only (gives
C incorrect results for orthorhombic)
C
HIGHSYM = (NLAUE.GT.6)
C
C---- Now need to discriminate whether to use THETAUNIQ or THETAUNIQ+180
C
IF (HIGHSYM) THEN
DELPHIL(3) = DELPHI(3) + THETAUNIQ
CALL ALIGN2(DELPHIL,AMAT,AREAL,BREAL,CREAL)
DO 50 I = 1,3
AANG(I) = ACOS(AREAL(I))/DTOR
BANG(I) = ACOS(BREAL(I))/DTOR
CANG(I) = ACOS(CREAL(I))/DTOR
50 CONTINUE
IF (AANG(3).LE.90.0) THEN
IF (AANG(2).LE.90.0) THETAUNIQ = THETAUNIQ + 180.0
ELSE
IF (AANG(2).GT.90.0) THETAUNIQ = THETAUNIQ + 180.0
END IF
C
WRITE(IOUT,FMT=6070) ABCSTR(IUNIQ), THETAUNIQ
IF (ONLINE) WRITE(ITOUT,FMT=6070) ABCSTR(IUNIQ), THETAUNIQ
6070 FORMAT(/,1X,'Unique axis is: ',A,/,1X,'Rotation angle to',
+ ' get the unique axis into the YZ plane:',F7.1)
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6072) ABCSTR(IUNIQ)
6072 FORMAT('Unique axis is: ',A)
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6074) THETAUNIQ
6074 FORMAT('Rotation angle to get the unique axis into the',
+ ' YZ plane:',F7.1)
CALL MXDWIO(LINE,1)
END IF
ELSE
C
C---- For orthorhombic space groups, need to find best starting phi
C Find the solution for which axis to put in the XZ plane as the
C one which gives the smallest possible angle between a real space
C axis and the X-axis.
C
ANGMIN = 200
DO 70 I = 1,3
IF (I.EQ.IAXIS) GOTO 70
DELPHIL(3) = DELPHI(3) + THETA(I)
CALL ALIGN2(DELPHIL,AMAT,AREAL,BREAL,CREAL)
ANGTOX(1) = ACOS(AREAL(1))/DTOR
ANGTOX(2) = ACOS(BREAL(1))/DTOR
ANGTOX(3) = ACOS(CREAL(1))/DTOR
DO 60 J = 1,3
IF (ANGTOX(J).GT.90.0) ANGTOX(J) = 180.0 - ANGTOX(J)
IF (ANGTOX(J).LT.ANGMIN) THEN
ANGMIN = ANGTOX(J)
JAXIS = I
END IF
60 CONTINUE
C
IF (DEBUG(60)) THEN
WRITE(IOUT,FMT=6080) ABCSTR(I),(ANGTOX(J),J=1,3),JAXIS
IF (ONLINE) WRITE(ITOUT,FMT=6080) ABCSTR(I),
+ (ANGTOX(J),J=1,3),JAXIS
6080 FORMAT(1X,'Testing axis ',A,' angles of a,b,c to X axis',
+ ' are:',3F6.0,' JAXIS chosen as',I2)
END IF
70 CONTINUE
C
C---- Have now chosen which axis is to go in XZ plane, now need to select
C between this angle and this angle plus 180. Choose the one which
C places the axis closest to the rotation axis at less than 90 degrees
C from Y.
C
THADD = 0.0
DO 80 I = 1,2
DELPHIL(3) = DELPHI(3) + THETA(JAXIS)
IF (I.EQ.2) DELPHIL(3) = DELPHIL(3) + 180
CALL ALIGN2(DELPHIL,AMAT,AREAL,BREAL,CREAL)
ANGTOX(1) = ACOS(AREAL(2))/DTOR
ANGTOX(2) = ACOS(BREAL(2))/DTOR
ANGTOX(3) = ACOS(CREAL(2))/DTOR
IF (ANGTOX(IAXIS).LE.90.0) THEN
IF (I.EQ.1) THEN
THADD = 0.0
ELSE
THADD = 180.0
END IF
IF (TRUANG.LE.90.0) THADD = THADD - 180.0
END IF
IF (DEBUG(60)) THEN
WRITE(IOUT,FMT=6082) I,IAXIS,JAXIS,ABCSTR(IAXIS),
+ ANGTOX(IAXIS),THADD
IF (ONLINE) WRITE(ITOUT,FMT=6082) I,IAXIS,JAXIS,
+ ABCSTR(IAXIS),ANGTOX(IAXIS),THADD
6082 FORMAT(1X,'I=',I3,' IAXIS=',I2,' JAXIS=',I2,' Angle ',
+ 'between ',A,' axis and Y axis',F6.1,' THADD',F6.0)
END IF
80 CONTINUE
END IF
C
C---- Test for possibility of missing CUSP data
C
THETAMAX = ASIN(DSTMAX/2.0)/DTOR
C
C---- Triclinc...always cusp data
C
IF (NLAUE.EQ.3) THEN
WRITE(IOUT,FMT=6050)
IF (ONLINE) WRITE(ITOUT,FMT=6050)
6050 FORMAT(/,1X,'***** WARNING *****',/,1X,'***** WARNING *****',
+ /,1X,'***** WARNING *****',/,1X,'***** WARNING *****',/,1X,
+ 'In triclinc space groups',
+ ' it is not possible to collect 100% complete',/,1X,
+ 'data rotating about a single axis, some data will ',
+ 'always be lost in the cusp',/)
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6050)
CALL WINDIO(NULINE)
END IF
ELSE IF (NLAUE.EQ.4) THEN
C
C---- Monoclinic, need 2-fold to lie between thetamax and 90-thetamax
C away from the rotation axis.
C
NOCUSP = ((90.0-THETAMAX.GE.ZANG(2)).AND.(ZANG(2).GE.THETAMAX))
IF (.NOT.NOCUSP) THEN
WRITE(IOUT,FMT=6052) 90.0-THETAMAX, THETAMAX
IF (ONLINE) WRITE(ITOUT,FMT=6052) 90.0-THETAMAX, THETAMAX
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6052) 90.0-THETAMAX, THETAMAX
CALL WINDIO(NULINE)
END IF
END IF
6052 FORMAT(/,1X,'***** WARNING *****',/,1X,'***** WARNING *****',
+ /,1X,'***** WARNING *****',/,1X,'***** WARNING *****',/,1X
+ ,'With the crystal in the current orientation it is not',
= ' possible to collect',/,1X,'100% of the data, some ',
+ 'will be lost in the cusp.',/,1X,'To avoid a cusp, the',
+ ' b-axis must be at an angle between',F5.1,' and',F5.1,
+ ' degrees',/,1X,'away from the rotation axis (Z)',
+ /,1X,'You may want to adjust the orientation with the',
+ ' goniometer arcs.',/)
ELSE IF (NLAUE.EQ.6) THEN
C
C---- Orthorhombic, a,b or c must lie between thetamax and 90-thetamax
C away from the rotation axis.
C
NOCUSP =(((90.0-THETAMAX.GE.ZANG(1)).AND.(ZANG(1).GE.THETAMAX))
+ .OR.
+ ((90.0-THETAMAX.GE.ZANG(2)).AND.(ZANG(2).GE.THETAMAX))
+ .OR.
+ ((90.0-THETAMAX.GE.ZANG(3)).AND.(ZANG(3).GE.THETAMAX)))
IF (.NOT.NOCUSP) THEN
WRITE(IOUT,FMT=6054) 90.0-THETAMAX, THETAMAX
IF (ONLINE) WRITE(ITOUT,FMT=6054) 90.0-THETAMAX, THETAMAX
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6054) 90.0-THETAMAX, THETAMAX
CALL WINDIO(NULINE)
END IF
END IF
6054 FORMAT(/,1X,'***** WARNING *****',/,1X,'***** WARNING *****',
+ /,1X,'***** WARNING *****',/,1X,'***** WARNING *****',/,1X
+ ,'With the crystal in the current orientation it is not',
= ' possible to collect',/,1X,'100% of the data, some ',
+ 'will be lost in the cusp.',/,1X,'To avoid a cusp, the',
+ ' a,b or c axes must be at an angle between',F5.1,' and',
+ F5.1,' degrees',/,1X,'away from the rotation axis (Z)',
+ /,1X,'You may want to adjust the orientation with the',
+ ' goniometer arcs.',/)
C
ELSE IF ((NLAUE.EQ.7).OR.(NLAUE.EQ.9).OR.(NLAUE.EQ.12)) THEN
C
C---- Laue groups 3/m,4/m,6/m (ie one unique axis), the unqie axis must
C lie betweeen 90-thetmax and thetamax from rotn axis.
NOCUSP = ((90.0-THETAMAX.GE.ZANG(3)).AND.(ZANG(3).GE.THETAMAX))
IF (.NOT.NOCUSP) THEN
WRITE(IOUT,FMT=6056) 90.0-THETAMAX, THETAMAX
IF (ONLINE) WRITE(ITOUT,FMT=6056) 90.0-THETAMAX, THETAMAX
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6056) 90.0-THETAMAX, THETAMAX
CALL WINDIO(NULINE)
END IF
END IF
6056 FORMAT(/,1X,'***** WARNING *****',/,1X,'***** WARNING *****',
+ /,1X,'***** WARNING *****',/,1X,'***** WARNING *****',/,1X
+ ,'With the crystal in the current orientation it is not',
= ' possible to collect',/,1X,'100% of the data, some ',
+ 'will be lost in the cusp.',/,1X,'To avoid a cusp, the',
+ ' c-axis must be at an angle between',F5.1,' and',F5.1,
+ ' degrees',/,1X,'away from the rotation axis (Z)',
+ /,1X,'You may want to adjust the orientation with the',
+ ' goniometer arcs.',/)
END IF
C
C---- PHIZONE must be an integral number of degrees
C
PHIZONE = REAL(NINT(THETA(JAXIS))) + THADD
IF (PHIZONE.GT.360.0) PHIZONE = PHIZONE - 360.0
IF (PHIZONE.LT.0.0) PHIZONE = PHIZONE + 360.0
IF (NEWSTRAT) PHIZONE = PHIZONE + 180.0
IZONEAX = JAXIS
IF (HIGHSYM) THEN
PHIZONE = REAL(NINT(THETAUNIQ))
IZONEAX = IUNIQ
END IF
END
C== ALIGN2 ==
C
SUBROUTINE ALIGN2(DELPHI,AMAT,AREAL,BREAL,CREAL)
C ================================================
C
IMPLICIT NONE
C
C---- To determine the orientation of the real space axes wrt the laboratory
C frame and the rotation requiredto bring real space axes into the plane
C containing the rotation axis and the X-ray beam
C Called from ALIGN
C
C ..
C .. Scalar Arguments ..
C ..
C .. Array Arguments ..
REAL DELPHI(3),AMAT(3,3),AREAL(3),BREAL(3),CREAL(3)
C
C ..
C .. Local Scalars ..
INTEGER I,J
C ..
C .. Local Arrays ..
REAL RMAT(3,3),WORK(3,3),ASTAR(3),BSTAR(3),CSTAR(3),v1(3)
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C---- Form product of misseting angles and A matrix.
C First convert missets to a rotation matrix
C
CALL ROTMAT(DELPHI,WORK,1)
C
C---- Form product with AMAT (A=BC)
C
CALL MATMUL3(RMAT,WORK,AMAT)
C
C---- Get A*,B*,C* vectors
C
V1(1) = 1
V1(2) = 0
V1(3) = 0
CALL MATVEC(ASTAR,RMAT,V1)
V1(1) = 0
V1(2) = 1
V1(3) = 0
CALL MATVEC(BSTAR,RMAT,V1)
V1(1) = 0
V1(2) = 0
V1(3) = 1
CALL MATVEC(CSTAR,RMAT,V1)
CAL WRITE(6,*),'ASTAR,BSTAR,CSTAR',ASTAR,BSTAR,CSTAR
C
C---- Convert to unit vectors
C
CALL UNIT(ASTAR)
CALL UNIT(BSTAR)
CALL UNIT(CSTAR)
C
C---- Get unit vectors along real space axes a,b,c
C
CALL CROSS(AREAL,BSTAR,CSTAR)
CALL CROSS(BREAL,CSTAR,ASTAR)
CALL CROSS(CREAL,ASTAR,BSTAR)
C
C---- Convert to unit vectors
C
CALL UNIT(AREAL)
CALL UNIT(BREAL)
CALL UNIT(CREAL)
CAL WRITE(6,*),'AREAL,BREAL,CREAL',AREAL,BREAL,CREAL
IF (DEBUG(60)) THEN
WRITE(IOUT,FMT=6000) (DELPHI(I),I=1,3),
+ ((WORK(I,J),J=1,3),I=1,3),
+ ((RMAT(I,J),J=1,3),I=1,3),
+ ASTAR,BSTAR,CSTAR,AREAL,BREAL,CREAL
IF (ONLINE) WRITE(ITOUT,FMT=6000) (DELPHI(I),I=1,3),
+ ((WORK(I,J),J=1,3),I=1,3),
+ ((RMAT(I,J),J=1,3),I=1,3),
+ ASTAR,BSTAR,CSTAR,AREAL,BREAL,CREAL
6000 FORMAT(1X,'Missets ',3F10.3,/,1X,'Corresponding matrix:',/,
+ 3(1X,3F10.7/),/,1X,'Modified AMAT',/,
+ 3(1X,3F10.7/),/,1X,'Unit vectors along a*:',3F10.5,/,1X,
+ ' along b*:',3F10.5,/,1X,
+ ' along c*:',3F10.5,/,1X,
+ ' along a :',3F10.5,/,1X,
+ ' along b :',3F10.5,/,1X,
+ ' along b :',3F10.5)
END IF
C
C---- Get angles with lab X,Y,Z axes
C
DO 20 I = 1,3
IF (ABS(AREAL(I)).GT.1.0) AREAL(I) = SIGN(1.0,AREAL(I))
IF (ABS(BREAL(I)).GT.1.0) BREAL(I) = SIGN(1.0,BREAL(I))
IF (ABS(CREAL(I)).GT.1.0) CREAL(I) = SIGN(1.0,CREAL(I))
20 CONTINUE
C
C
END
C
C Routine to allow different integration of different resolution limits in
C each of three reciprocal axis directions; an ellipsoid is calculated with
C its long principal axis coaxial with the longest reciprocal axis, and the
C shorter axes orthogonal to this. The observant will notice that the code
C is derived from the CCP4 subroutine RBFR01.
C
C ===============================
SUBROUTINE ANIRES(ORTMAT)
C ===============================
C
C
C ORTMAT (O) (REAL(3,3)) Standard orthogonisational matrix
C
C this generates the various orthogonalising matrices
C ' NCODE =1 - ORTHOG AXES ARE DEFINED TO HAVE'
C A PARALLEL TO XO CSTAR PARALLEL TO ZO'
C
C SET UP MATRICES TO ORTHOGONALISE H K L AND X Y Z FOR THIS CELL.
C
C
C---- Returned arrays
C
REAL ORTMAT(3,3)
C
C---- Local arrays
C
C RECELL is wavelength independent reciprocal cell
C
REAL RECELL(6)
C
C---- Local Scalars
C
REAL A,ALPH,B,BET,C,GAMM,DTOR,COSA,COSAS,COSB,COSBS,SINBS,
+ COSG,COSGS,SINGS,FCT,SINA,SINB,SING,SUM,V,VOL,PI
INTEGER I,J,K,N
C
C---- include files
C
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C
C---- Intrinsic Functions
C
INTRINSIC ATAN,ATAN2,COS,SIN,SQRT
C
C---- External routines
C
EXTERNAL RECCEL
C
C---- Remember we're using the wavelength independent reciprocal cell...
C
CALL RECCEL(RECELL,CELL,1.00)
PI = ATAN(1.0)*4.0
DTOR = PI/180.0
FCT = 8.0*PI*PI
ALPH = RECELL(4)*DTOR
BET = RECELL(5)*DTOR
GAMM = RECELL(6)*DTOR
SUM = (ALPH+BET+GAMM)*0.5
V = SQRT(SIN(SUM-ALPH)*SIN(SUM-BET)*SIN(SUM-GAMM)*SIN(SUM))
VOL = 2.0*RECELL(1)*RECELL(2)*RECELL(3)*V
SINA = SIN(ALPH)
COSA = COS(ALPH)
SINB = SIN(BET)
COSB = COS(BET)
SING = SIN(GAMM)
COSG = COS(GAMM)
COSAS = (COSG*COSB-COSA)/ (SINB*SING)
SINAS = SQRT(1.0-COSAS*COSAS)
COSBS = (COSA*COSG-COSB)/ (SINA*SING)
SINBS = SQRT(1.0-COSBS*COSBS)
COSGS = (COSA*COSB-COSG)/ (SINA*SINB)
SINGS = SQRT(1.0-COSGS*COSGS)
A = RECELL(1)*RESANI(1)
B = RECELL(2)*RESANI(2)
C = RECELL(3)*RESANI(3)
C
C---- Zero matrices
C
DO 30 I = 1,3
DO 20 J = 1,3
ORTMAT(I,J) = 0.0
20 CONTINUE
30 CONTINUE
IF ((C.GT.A).AND.(C.GT.B)) THEN
C
C---- c* longest
C
ORTMAT(1,1) = A
ORTMAT(1,2) = B*COSG
ORTMAT(1,3) = C*COSB
ORTMAT(2,2) = B*SING
ORTMAT(2,3) = -C*SINB*COSAS
ORTMAT(3,3) = C*SINB*SINAS
ELSE IF ((A.GT.B).AND.(A.GT.C))THEN
C
C---- a* longest
C
ORTMAT(1,1) = A*COSG
ORTMAT(1,2) = B
ORTMAT(1,3) = C*COSA
ORTMAT(2,1) = -A*SING*COSBS
ORTMAT(2,3) = C*SINA
ORTMAT(3,1) = A*SING*SINBS
ELSE
C
C---- b* longest
C
ORTMAT(1,1) = A*COSB
ORTMAT(1,2) = B*COSA
ORTMAT(1,3) = C
ORTMAT(2,1) = A*SINB
ORTMAT(2,2) = -B*SINA*COSGS
ORTMAT(3,2) = B*SINA*SINGS
ENDIF
C
C
C
RETURN
END
C
C
C== AREA ==
REAL FUNCTION AREA(XYP,XY)
C ..
C .. Array Arguments ..
REAL XYP(2),XY(2,4)
C
C .. Local scalars
REAL A,AR
INTEGER I,J
C
C .. Local arrays
REAL DXY(2,4)
C ..
C .. External Subroutines ..
EXTERNAL V2SUB,V2CROSS
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C
DO 10 I=1,4
CALL V2SUB(XYP,XY(1,I),DXY(1,I))
10 CONTINUE
A = 0.0
DO 20 I = 1,4
J = I + 1
IF (J.GT.4) J = 1
CALL V2CROSS(DXY(1,I),DXY(1,J),AR)
A = A + AR
20 CONTINUE
AREA = ABS(0.5*A)
END
C
C
C== AREAQ ==
REAL FUNCTION AREAQ(XY)
C ..
C .. Array Arguments ..
REAL XY(2,4)
C
C .. Local scalars
INTEGER I
REAL XG,YG
C
C .. Local arrays
REAL XYG(2)
C ..
C .. External Functions ..
REAL AREA
EXTERNAL AREA
XG = 0.0
YG = 0.0
DO 10 I=1,4
XG = XG + XY(1,I)
YG = YG + XY(2,I)
10 CONTINUE
XYG(1) = XG/4.0
XYG(2) = YG/4.0
AREAQ = AREA(XYG,XY)
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== AUTOMATCH ==
SUBROUTINE AUTOMATCH(DOPROFILE,NSIG,IXSHIFT,IYSHIFT,NPROFL,LIMIT,
+ SEP,VLIM,FAIL,LIST,USEBOX,
+ ADDPART,RWEIGHT,PTMIN,
+ REFREJ,THICK,FIRSTFILM,NUMBLOCK,MOSEST,IERR)
C =================================================================
IMPLICIT NONE
C
C---- Last modified 8/6/93 replace SUMPART by ADDPART, SUMPART no longer
C used
C---- Last modified 26/8/92 for mosaic spread refinement
C---- Last modified 16/10/91 for TRUECCOM etc
C---- Last modified 11/7/89 change params for S/R NEXT (Add PARTLS)
C Last modified 6/10/88
C
C---- This subroutine allows automatic pattern matching using
C a modified version of the convolution technique described
C by Rossmann (1978).
C
C Works with missetting angles PSIX,PSIY,PSIZ rather than
C PHIX,PHIY,PHIZ.
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL VLIM,SEP,PTMIN,REFREJ,THICK
INTEGER IXSHIFT,IYSHIFT,LIMIT,NPROFL,NSIG,NUMBLOCK,IERR
LOGICAL DOPROFILE,FAIL,LIST,USEBOX,ADDPART,RWEIGHT,
+ FIRSTFILM,NEWPREF,MOSEST
C
C .. Local Scalars ..
REAL DELPSI,DTOR,ETANEW,OMEGA0,OSCRANGE,PHIAV,PI,R,RESOL,
+ SDGN,SDISPLAY,SDLO,SECT,SHIFT,SHIFTM,SHIFTT,SHMAXM,SHMAXT,
+ TDAMP,TEMP,TH,THETA,VAR,X,AELIMIT2,AELIMIT3,DELETA,SCALE,
+ AWELIMIT,XLIMIT,LPTMIN,FVAR,SIGX,SIGX2,SIGY,SIGXY
INTEGER I,ICYC,IDELX,IDELY,IFAIL,IGAIND,ILOST,INT,
+ INTGAIN,INTLOST,INTMAX,INTMIN,IPASS,IS,ISDGAIN,ISDLOST,
+ ISNEG,ISPOS,ISTEP,IVAR,IYZ,JSTEP,MINREF,MODE,
+ NBIG,NC,NGAIN,NLOST,NM,NPR,NRJ,NRM,NRX,NRY,NXS,NYS,
+ NRSOLD,IFLAG,MEANINT,IDDUM,iii,lastrec
LOGICAL BADSTART,CENTRE,FORCE,GENLIST,INTERPOL,OLDLIST,OVRLDS,
+ PARTLS,PRECESS,LPROFILE,RESCAN,YES,LPOSTREF,FINAL,
+ DPOWDER,RRWEIGHT,USEWEIGHT,REFETA,OKREF,LCENTRAL,
+ LLAST,LMULTISEG,INTCHK
C ..
C .. Local Arrays ..
REAL PSI(3),RDELPHI(3),SHPSI(3),SPSI(3),XDELPHI(3),ETASTEP(41)
INTEGER IGN(-20:20),ILO(-20:20),INTTOT(-20:20,2:3),
+ ISDGN(-20:20),
+ ISDLO(-20:20),ISDTOT(-20:20,2:3),NGL(-20:20),IRSAVE(62)
CHARACTER PSISTR(6)*4
C ..
C .. External Subroutines ..
EXTERNAL CENTRS,GENSORT,
+ MEAS,NEWLIST,NEXT,PHITOPSI,PSITOPHI,RDIST,REFLMATCH,
+ SECTOR,SETMAT,YESNO
INTEGER LENSTR, XDLSTR
EXTERNAL LENSTR, XDLSTR
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ASIN,ATAN,ATAN2,COS,MAX,MIN,SIN,SQRT,TAN
C ..
C .. Common blocks ..
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/reflist.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reflist.h
C---- START of include file reflist.h
C
C
C .. Arrays in common block /REFLIST/ ..
INTEGER XREF,YREF,INTREF,ISDREF
C ..
C .. Common Block /REFLIST/ ..
COMMON /REFLIST/XREF(NREFLS),YREF(NREFLS),INTREF(NREFLS),
+ ISDREF(NREFLS)
C ..
C
C
C&&*&& end_include ../inc/reflist.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/saveit.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file saveit.h
C---- START of include file saveit.h
C
C
C .. Scalars in common block /SAVEIT/ ..
REAL SETA,SDIVH,SDIVV
C ..
C .. Arrays in common block /SAVEIT/ ..
REAL SDELPHI
C .. Common Block /SAVEIT/ ..
COMMON /SAVEIT/SDELPHI(3),SETA,SDIVH,SDIVV
C ..
C
C
C&&*&& end_include ../inc/saveit.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
C ..
SAVE
C .. Data statements ..
DATA PSISTR/'PSIX','PSIY','PSIZ','DIV ','DIVH','DIVV'/
DATA AWELIMIT/2.0/
C ..
C
C
IDDUM = 0
DPOWDER = .FALSE.
LPOSTREF = .FALSE.
LLAST = .FALSE.
MATCH = .TRUE.
FAIL = .FALSE.
FORCE = .FALSE.
LIST = .FALSE.
PRECESS = .FALSE.
LPROFILE = .FALSE.
INTERPOL = .FALSE.
RESCAN = .TRUE.
REFETA = .FALSE.
LMULTISEG = .FALSE.
INTCHK = .FALSE.
C
C aelimit=20.
C armslim=20.
C
PI = ATAN(1.0)*4.0
DTOR = PI/180.0
C
C
C---- Convert phi to psi
C
PHIAV = (PHIBEG+PHIEND)*0.5 + DELPHI(3)
C
C **************************
CALL PHITOPSI(DELPHI,PSI,PHIAV)
C **************************
C
C---- Save these psi and starting delphi values
C
DO 10 I = 1,3
XDELPHI(I) = DELPHI(I)
SDELPHI(I) = DELPHI(I)
SPSI(I) = PSI(I)
10 CONTINUE
C
C
SETA = ETA
SDIVH = DIVH
SDIVV = DIVV
C
C
IF (DEBUG(30)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) DELPHI,PSI,PHIAV,2*ETA/DTOR,
+ 2*DIVH/DTOR,2*DIVV/DTOR
6000 FORMAT (' Entering AUTOMATCH',/1X,'DELPHI ',3F6.2,5X,'DELPSI ',
+ 3F6.2,5X,'PHIAV ',F6.2,' ETA ',F6.3,' DIVH,V ',2F6.3)
WRITE (IOUT,FMT=6000) DELPHI,PSI,PHIAV,2*ETA/DTOR,
+ 2*DIVH/DTOR,2*DIVV/DTOR
END IF
C
C---- Do initial call to set up standard profiles and to RMAXR to
C calculate box sizes, as these are needed by NEXT. For IP data,
C only need to do this once, but for film data the position of
C the direct beam in the digitised image can vary from one
C pack to the next, so need to set it up for every pack.
C (Same will be true for IP data from an offline scanner)
C
IF (.NOT.IMGP) THEN
CALL PRSETUP
ierr = 0
C ***********************
IF (FIRSTFILM) CALL RMAXR(LIMIT,THICK,IERR)
C ***********************
ELSE
IF (FIRSTFILM.AND.NUMBLOCK.EQ.1) THEN
CALL PRSETUP
CALL RMAXR(LIMIT,THICK,IERR)
END IF
END IF
C
C---- Skip centrs if in mode 2 operation
C
IF (NOCENT) GO TO 110
C
C---- Initialise variables for centrs
C
PARTLS = .TRUE.
OVRLDS = .TRUE.
GENLIST = .FALSE.
MINREF = 8
LPTMIN = 0.1
C
C---- Test if oscillation range is large enough to get
C sufficient overlap of calculated patterns and real
C pattern with missetting equal to the desired range of
C convergence
C
OSCRANGE = ABS(PHIEND-PHIBEG)
IF (OSCRANGE.GT.360.0) OSCRANGE = OSCRANGE - 360.0
C
C
C---- Calculate resolution based on 'limit'
C
20 R = LIMIT*1.4142
IF (VEE) R = SQRT(LIMIT**2+VLIM**2)
TH = ATAN(R/XTOFD)*0.5
RESOL = 0.5*WAVE/SIN(TH)
IF (OSCRANGE.LT. (RCONV+OVRLAP)) THEN
C
C---- Not enough overlap, regenerate with increased mosaic spread
C
ETANEW = (RCONV+OVRLAP) - OSCRANGE
C
IF (ONLINE) WRITE (ITOUT,FMT=6002) OSCRANGE,RCONV,OVRLAP,
+ ETANEW
6002 FORMAT (/,' OSC Range of ',F5.1,' Degrees is TOO SMALL to give ',
+ 'a radius of convergence'/,1X,'of',F5.2,' degrees with an',
+ ' overlap of',F6.1,' degrees.',/1X,'ETA increased to',F5.2,
+ ' degrees')
WRITE (IOUT,FMT=6002) OSCRANGE,RCONV,OVRLAP,ETANEW
ELSE
ETANEW = SETA/DTOR
END IF
C
IFLAG = 0
C
C ***********************************
CALL NEWLIST(ETANEW,PSI,PHIAV,RESOL,IFLAG)
C ***********************************
C
C---- Now run centrs to locate spots in central region of film
C note that fulls and partials will be used in centrs for the
C first (low resolution) pass
C
C
C---- Store DELPHI values used at CENTRS time
C
40 CONTINUE
C
C
DO 50 I = 1,3
XDELPHI(I) = DELPHI(I)
50 CONTINUE
C
C---- Now do CENTRS refinement
C
DO 70 ICYC = 1,NCYCA
FINAL = (ICYC.EQ.NCYCA)
IF (ONLINE) THEN
C
C
WRITE (ITOUT,FMT=6004) ICYC
6004 FORMAT (/,' Refinement Cycle',I3)
END IF
C
C
WRITE (IOUT,FMT=6004) ICYC
C
C---- In centrs, the background definition of the measurement box
C is not used to determine the centre of gravity (the c of g over
C the whole measurement box is calculated...this gives a greater
C range of convergence). in second and subsequent cycles, if the
C final residual of the previous cycle is less then rmslim
C (default value 6.0, can be changed by keyword "resid"), use the
C same list of reflections and s/r 'next' to evaluate the true
C c of g for these reflections
C
IF (RRWEIGHT) THEN
OKREF = (WRMSRES.LE.AWRMSLIM)
ELSE
OKREF = (RMSRES.LE.ARMSLIM)
END IF
IF ((ICYC.GT.1) .AND. (OKREF) .AND.
+ (.NOT.DOPROFILE)) THEN
LIST = .TRUE.
C
C---- Restore original list of reflections from CENTRS so they are
C all remeasured by NEXT
C
NRS = NRSOLD
DO 106 I = 1,NRS
RRS(I) = IRSAVE(I)
106 CONTINUE
IF (ONLINE) WRITE (ITOUT,FMT=6006) NRS
6006 FORMAT (/,' Repeating refinement using the same list of',I3,' R',
+ 'eflections')
WRITE (IOUT,FMT=6006) NRS
USEWEIGHT = .TRUE.
LCENTRAL = .TRUE.
C
C *****************************************************
CALL NEXT(LIST,IXSHIFT,IYSHIFT,PRECESS,MATCH,IFAIL,PARTLS,
+ ADDPART,LCENTRAL)
C ******************************************************
C
ELSE
OLDLIST = (ICYC.NE.1)
USEWEIGHT = .TRUE.
IF (.NOT.USEBOX) THEN
USEWEIGHT = .FALSE.
C
C---- If doing weighted refinement, set RMSLIM high so that on next
C cycle it will use the measurement box
C
IF (RWEIGHT) ARMSLIM = 100.0
END IF
C
C ********************************************************
CALL CENTRS(DOPROFILE,NSIG,IXSHIFT,IYSHIFT,NPROFL,LIMIT,SEP,
+ VLIM,MATCH,PARTLS,OVRLDS,MINREF,OLDLIST,GENLIST,USEBOX,
+ ADDPART,LPTMIN)
C ********************************************************
NRSOLD = NRS
C
C---- Save this list of reflections for use in subsequent refinement using
C NEXT
C
DO 108 I = 1,NRS
IRSAVE(I) = RRS(I)
108 CONTINUE
C
END IF
C
C
IF (NRS.GT.MINREF) GO TO 60
WRITE (IOUT,FMT=6008) NRS
6008 FORMAT (//1X,'**** ONLY',I3,' Refinement spots found, Processing',
+ ' abandoned ***')
IF (ONLINE) WRITE (ITOUT,FMT=6008) NRS
FAIL = .TRUE.
C
C---- reset divergences and mosaic spread
C
ETA = SETA
DIVH = SDIVH
DIVV = SDIVV
GO TO 999
C
C---- Refinement
C
60 TEMP = DISPLAY
C
C---- In centrs, only spots within 'limit' 10 micron units (default 25mm)
C of film centre are used except for vee when 'vlim' (default 40mm)
C is the limit.
C these limits can be changed by keywords 'limit' and 'vlimit' or
C in centrs if all central reflections are overloads.
C
DISPLAY = LIMIT/100.0
IF (VEE) DISPLAY = VLIM/100.0
C
DISPLAY = TEMP
CENTRE = .TRUE.
C
C
IF (VEE) THEN
C
ELSE
C
RRWEIGHT = (RWEIGHT.AND.USEWEIGHT)
C ******************************************
CALL RDIST(CENTRE,FINAL,AWELIMIT,AELIMIT,AELIMIT2,AELIMIT3,
+ BADSTART,RRWEIGHT,REFREJ)
C ******************************************
C
END IF
C
C
CENTRE = .FALSE.
70 CONTINUE
C
C---- End of loop over refinement cycles
C
IF (RWEIGHT) THEN
IF (WRMSRES.LT.AWRMSLIM) GO TO 90
ELSE
IF (RMSRES.LT.ARMSLIM) GO TO 90
END IF
C
C---- If online, optionall call filmplot
C
IF (ONLINE) THEN
C
IF (RWEIGHT) THEN
WRITE (ITOUT,FMT=6011) AWRMSLIM
IF (BRIEF) WRITE (IBRIEF,FMT=6011) AWRMSLIM
6011 FORMAT(1X,'Weighted residual is GREATER than limit (',F5.1,')',
+ /,1X,'Set by RESID on AUTOMATCH card',/,1X,'Do y',
+ 'ou want to proceed anyway (Y/N)? ')
ELSE
WRITE (ITOUT,FMT=6010) ARMSLIM
IF (BRIEF) WRITE (IBRIEF,FMT=6010) ARMSLIM
6010 FORMAT (' Residual is GREATER than limit (',F5.1,')',/1X,
+ 'Set by RESID on AUTOMATCH card',/,1X,'Do y',
+ 'ou want to proceed anyway (Y/N)? ')
END IF
C
C **********
CALL YESNO(YES)
C **********
C
IF (YES) THEN
GO TO 100
ELSE
WRITE (ITOUT,FMT=6012)
6012 FORMAT (' Do you want to repeat refinement (Y/N) ? ')
C
C **********
CALL YESNO(YES)
C **********
C
IF (YES) THEN
GO TO 40
END IF
END IF
END IF
FAIL = .TRUE.
IF (RWEIGHT) THEN
WRITE(IOUT,FMT=6015) AWRMSLIM
IF (ONLINE) WRITE(ITOUT,FMT=6015) AWRMSLIM
6015 FORMAT(//1X,'Residual following refinement is greater than ',F6.1,
+ ' (subkeyword RESID on AUTO)',/,1X,'Processing abandoned')
ELSE
WRITE(IOUT,FMT=6017) ARMSLIM
IF (ONLINE) WRITE(ITOUT,FMT=6017) ARMSLIM
6017 FORMAT(//1X,'Residual following refinement is greater than ',F6.1,
+ ' (subkeyword RESID on AUTO)',/,1X,'Processing abandoned')
END IF
C
C---- reset divergences and mosaic spread
C
ETA = SETA
DIVH = SDIVH
DIVV = SDIVV
GO TO 999
C
C---- If centrs has already been repeated due to poor initial residual
C do not allow a second repeat.
C
90 IF (BADSTART) GO TO 100
IF (RWEIGHT) THEN
BADSTART = (WESTART.GT.AWELIMIT)
XLIMIT = AWELIMIT
ELSE
BADSTART = (ESTART.GT.AELIMIT)
XLIMIT = AELIMIT
END IF
C
C---- Repeat centrs if initial residual high
C
IF (BADSTART) THEN
WRITE (IOUT,FMT=6016) XLIMIT
6016 FORMAT (/,' Repeat refinement because initial residual is GREAT',
+ 'ER than',F5.1)
IF (ONLINE) WRITE (ITOUT,FMT=6016) XLIMIT
GO TO 40
END IF
C
C---- Centrs refinement successfull
C update psix by the refined value of (ccomega-trueccom)
C and adjust the value of OMEGA0 to reflect the change is PSIX
C Remember only SINOM0, COSOM0 carried in common ORI
C
100 IF (NOREFINE) GOTO 110
IF (ONLINE) WRITE (ITOUT,FMT=6018) PSI,DELPHI
6018 FORMAT (/,' Starting orientation refinement',/1X,'Initial MISSE',
+ 'TTING Angles ',/1X,'in PSI',3F8.3,/1X,'in PHI',3F8.3)
WRITE (IOUT,FMT=6018) PSI,DELPHI
PSI(1) = PSI(1) + (CCOM - TRUECCOM)
SPSI(1) = PSI(1)
SHPSI(1) = CCOM - TRUECCOM
OMEGA0 = ATAN2(SINOM0,COSOM0) - (CCOM - TRUECCOM)*DTOR
SINOM0 = SIN(OMEGA0)
COSOM0 = COS(OMEGA0)
CCOM = TRUECCOM
C
C---- Now generate the big list of reflections to be used
C in the pattern matching. the mosaic spread is increased
C to give the specified radius of convergence 'rconv'
C
110 ETANEW = 2*RCONV
IFLAG = 0
C
C---- If refining divergences, set appropriate ETANEW and IFLAG
C If not refining orientation, start with divergence refinement
C
IF (RMOSAIC.AND.NOREFINE) REFETA = .TRUE.
IF (REFETA) THEN
ETANEW = ETAMAX
IFLAG = 4
C
C---- Must set ETA to zero, so that total (beam divergence + mosaic spread)
C increases from zero
C
ETA = 0.0
END IF
C
C ************************************
CALL NEWLIST(ETANEW,PSI,PHIAV,RESOL1,IFLAG)
C ************************************
C
IF (DEBUG(31)) THEN
NPR = MIN(NSPOT,30)
IF (ONLINE) WRITE (ITOUT,FMT=6020) (I,XG(I),YG(I),I=1,NPR)
6020 FORMAT (/,' Coordinates of reflections from REEKE',
+ / (1X,I3,3X,2F7.1))
WRITE (IOUT,FMT=6020) (I,XG(I),YG(I),I=1,NPR)
END IF
C
C---- Measure intensities of all reflections in the big list
C first convert film coordinates to sorted scanner coordinates
C
MAXR = 1000
MODE = 6
C
C *****************************************************
CALL GENSORT(MODE,FORCE,LIMIT,VLIM,NRM,ADDPART,LPTMIN,LLAST)
C *****************************************************
C
NBIG = NRM
WRITE (IOUT,FMT=6022) SHPSI(1),TRUECCOM
6022 FORMAT (' PSIX changed by',F6.2,' Degrees and CCOMEGA set to',
+ F6.3)
IF (ONLINE) WRITE (ITOUT,FMT=6022) SHPSI(1),TRUECCOM
C
C
IF (DEBUG(30)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6024) NSPOT,ETANEW,RESOL1,NRM
6024 FORMAT (/1X,I5,' Spots generated in big list with ETA=',F5.2,' O',
+ 'ut to',F5.1,' Angstroms',/1X,I5,' of these selected by G',
+ 'ENSORT')
WRITE (IOUT,FMT=6024) NSPOT,ETANEW,RESOL1,NRM
END IF
C
C---- Now measure reflections
C
C *******************************************************
CALL MEAS(MAXR,LPROFILE,INTERPOL,IXSHIFT,IYSHIFT,
+ ADDPART,LPOSTREF,IDDUM,LMULTISEG,lastrec,NEWPREF)
C *******************************************************
C
IF (DEBUG(31)) THEN
NPR = MIN(NRM,30)
IF (ONLINE) WRITE (ITOUT,FMT=6026) (I,XREF(I),YREF(I),I=1,NPR)
6026 FORMAT (/,' Coordinates after storing in XREF,YREF',
+ / (1X,I3,3X,2I6))
WRITE (IOUT,FMT=6026) (I,XREF(I),YREF(I),I=1,NPR)
END IF
C
C---- Now the fun bit.
C reset mosaic spread to its correct value.
C vary first psiz from -rconv to +rconv in steps of
C rconv/nstep. for each value of psiz, calculate a
C new reflection list, and go through the big list
C and pick up the intensity and sd for these reflections.
C print statistics on number and intensity of
C reflections lost and gained.
C repeat the whole procedure varying psiy at the optimum
C value of psiz.
C if necessary, iterate the procedure.
C If refining mosaic spread, then increase divergence(s) from 0
C to ETAMAX in (2*NSTEP+1) steps
C
ETANEW = 0.0
DELPSI = RCONV/NSTEP
TDAMP = 1.0/DAMP
C
C---- Set error limits for matching reflections to half box size
C
IDELX = IRAS(1)*0.5
IDELY = IRAS(2)*0.5
IF (REFETA) THEN
IDELX = (IRAS(1)-2*IRAS(4))*0.5 + 1
IDELY = (IRAS(2)-2*IRAS(5))*0.5 + 1
END IF
C
C
DO 120 I = 2,3
SHPSI(I) = 0.0
120 CONTINUE
C
C---- For divergence refinement, set number of passes to number of
C parameters being refined
C
IF (REFETA) THEN
NPASS = 1
DELETA = ETAMAX/(2*NSTEP)
END IF
C
1341 CONTINUE
DO 220 IPASS = 1,NPASS
C
C
IF (REFETA) THEN
WRITE (IOUT,FMT=6027)
6027 FORMAT (/1X,'Beam divergence refinement')
IF (ONLINE) WRITE (ITOUT,FMT=6027)
ELSE
WRITE (IOUT,FMT=6028) IPASS
6028 FORMAT (/1X,'Orientation refinement pass',I3)
IF (ONLINE) WRITE (ITOUT,FMT=6028) IPASS
C
C---- Decrease delpsi by factor damp on each pass
C
IF (IPASS.NE.1) DELPSI = DELPSI*DAMP
ETANEW = DELPSI*NSTEP*0.5
TDAMP = TDAMP*DAMP
END IF
C
C
DO 210 IYZ = 3,2,-1
C
C---- Only one parameter (IYZ) if only one beam divergence being refined
C
IF (REFETA.AND.(NBEAM.EQ.1).AND.(IYZ.EQ.2)) GOTO 210
INTMAX = 0
C
C
IF (IYZ.EQ.3) THEN
SECT = 0.0
ELSE
SECT = 90.0
END IF
C
C
JSTEP = 0
IF (REFETA) ETANEW = -DELETA
C
C
DO 140 ISTEP = -NSTEP,NSTEP
JSTEP = JSTEP + 1
IF (REFETA) THEN
C
C---- Divergence refinement
C
ETANEW = ETANEW + DELETA
ETASTEP(JSTEP) = ETANEW
IF (NBEAM.EQ.1) THEN
IFLAG = 4
ELSE
IFLAG = 3 + IYZ
END IF
ELSE
C
C---- Orientation refinement
C
PSI(IYZ) = SPSI(IYZ) + ISTEP*DELPSI
IFLAG = IYZ
END IF
C
C **************************************
CALL NEWLIST(ETANEW,PSI,PHIAV,RESOL1,IFLAG)
C **************************************
C
IF (DEBUG(31)) THEN
NPR = MIN(NSPOT,30)
IF (ONLINE) WRITE (ITOUT,FMT=6020) (I,XG(I),YG(I),I=1,NPR)
WRITE (IOUT,FMT=6020) (I,XG(I),YG(I),I=1,NPR)
END IF
C
C---- Flag reflections outside required sector (secangle around
C sect=0 for psiz, around sect=90 for psiy refinement.
C
C *******************************
CALL SECTOR(SECT,SECANGLE,NSPOT,NRJ)
C *******************************
C
C---- Match reflections in small list to those in big list
C
C ****************************************************
CALL REFLMATCH(INT,FVAR,NBIG,NSPOT,NM,IDELX,IDELY,FORCE,
+ LIMIT,VLIM,JSTEP,INTGAIN,ISDGAIN,INTLOST,
+ ISDLOST,NGAIN,NLOST,ADDPART,LPTMIN)
C ****************************************************
C
NGL(ISTEP) = NGAIN + NLOST
IGN(ISTEP) = INTGAIN
ISDGN(ISTEP) = ISDGAIN
ILO(ISTEP) = INTLOST
ISDLO(ISTEP) = ISDLOST
INTTOT(ISTEP,IYZ) = INT/100
ISDTOT(ISTEP,IYZ) = SQRT(0.0001*FVAR)
MEANINT = 0
IF (NM.NE.0) MEANINT = INT/NM
C
C
IF (DEBUG(30)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6030) IYZ,ISTEP,PSI,NSPOT,
+ RESOL1,NM,IDELX,IDELY,INT,MEANINT,SECANGLE,
+ SECT,NRJ
6030 FORMAT (1X,'VARY PSI',I2,' ISTEP',I3,/,1X,'PSI',3F8.2,' NSPOT',
+ I5,
+ ' RESOL1',F5.1,' NMATCH',I5,' DX,DY',2I5,/1X,'Total ',
+ 'intensity',I12,' Mean intensity per spot',I8,/,1X,
+ 'Number rejected by sector angle of',F5.1,
+ ' Degrees at PSI=',F5.0, ' is',I5)
WRITE (IOUT,FMT=6030) IYZ,ISTEP,PSI,NSPOT,RESOL1,NM,
+ IDELX,IDELY,INT,MEANINT,SECANGLE,SECT,NRJ
END IF
C
C
IF (INT.GE.INTMAX)THEN
INTMAX = INT
IS = ISTEP
ENDIF
140 CONTINUE
C
C---- Don't attempt to find optimum for mosaic spread refinement
C
IF (REFETA) GOTO 180
C---- Now find the best match. starting at the maximum intensity,
C work outwards to find the two points where there is a
C significant (gt. 15*sigma) change in the gained/lost
C intensities.
C
ISTEP = IS
ILOST = 0
VAR = 0.0
150 ISTEP = ISTEP + 1
IF (ISTEP.GT.NSTEP) GO TO 160
ILOST = ILO(ISTEP) + ILOST
VAR = FLOAT(ISDLO(ISTEP)*ISDLO(ISTEP)) + VAR
SDLO = SQRT(VAR)
IF (DEBUG(30)) THEN
WRITE(IOUT,FMT=6031) ISTEP,ILO(ISTEP),ISDLO(ISTEP),
+ IGN(ISTEP),ISDGN(ISTEP),ILOST,
+ SDLO
6031 FORMAT(1X,'ISTEP=',I2,' intensity lost and sd',I6,I4,
+ ' Intensity gained and sd',I6,I4,/,1X,
+ ' Total intensity lost and sd',I6,F5.0)
IF (ONLINE) WRITE(ITOUT,FMT=6031) ISTEP,ILO(ISTEP),
+ ISDLO(ISTEP),IGN(ISTEP),ISDGN(ISTEP),
+ ILOST,SDLO
END IF
IF (FLOAT(ILOST).GT.15.0*SDLO) GO TO 160
GO TO 150
C
C---- Significant point found stepping positive, now go negative
C
160 ISPOS = ISTEP
ISTEP = IS + 1
VAR = 0.0
IGAIND = 0
170 ISTEP = ISTEP - 1
IF (ISTEP.LT.- (NSTEP-1)) GO TO 180
IGAIND = IGN(ISTEP) + IGAIND
VAR = FLOAT(ISDGN(ISTEP)*ISDGN(ISTEP)) + VAR
SDGN = SQRT(VAR)
IF (DEBUG(30)) THEN
WRITE(IOUT,FMT=6031) ISTEP,ILO(ISTEP),ISDLO(ISTEP),
+ IGN(ISTEP),ISDGN(ISTEP),ILOST,
+ SDLO
IF (ONLINE) WRITE(ITOUT,FMT=6031) ISTEP,ILO(ISTEP),
+ ISDLO(ISTEP),IGN(ISTEP),ISDGN(ISTEP),
+ ILOST,SDLO
END IF
IF (FLOAT(IGAIND).GT.15.0*SDGN) GO TO 180
GO TO 170
C
C---- Find median
C
180 ISNEG = ISTEP - 1
X = (ISPOS+ISNEG)*0.5
C
C---- Scale INTTOT if necessary
C
SCALE = 1.0
C IF (INTMAX.GT.9999900) SCALE = 9999900/REAL(INTMAX)
SCALE = 9999900/REAL(INTMAX)
C
C---- Next bit for mosaicity estimation only
C
IF(MOSEST)THEN
C
C---- work out slope etc here
C
SIGX = 0.0
SIGY = 0.0
SIGXY = 0.0
SIGX2 = 0.0
DO 3 ISTEP=NSTEP-5,NSTEP
SIGX = SIGX + ETASTEP(ISTEP+NSTEP)
SIGY = SIGY + NINT(SCALE*INTTOT(ISTEP,IYZ))
SIGXY = SIGXY + (ETASTEP(ISTEP+NSTEP)*
$ NINT(SCALE*INTTOT(ISTEP,IYZ)))
SIGX2 = SIGX2 +
$ (ETASTEP(ISTEP+NSTEP)*ETASTEP(ISTEP+NSTEP))
c PRINT*,ISTEP,ETASTEP(ISTEP+NSTEP),NINT(SCALE*INTTOT(ISTEP,IYZ))
3 ENDDO
SLOPE = MAX(0.0,((SIGX*SIGY)-(6*SIGXY))/
$ ((SIGX*SIGX)-(6*SIGX2)))
C INTERCEPT = ((SIGX*SIGXY)-(SIGX2*SIGY))/
C $ ((SIGX*SIGX)-(11*SIGX2))
C
C--- end of slope calculations
C
INTMIN = NINT((SCALE*INTTOT(-NSTEP,IYZ)/8.0)+
$ (700000.0/8.0))
DO 1342 III=1,2*NSTEP+1
C PRINT*,NINT(SCALE*INTTOT(III-1-(NSTEP),IYZ)
C $ +(ETASTEP(III)*SLOPE))
IF(INTMIN.LT.NINT(SCALE*INTTOT(III-1-(NSTEP),IYZ)
$ +(ETASTEP(III)*SLOPE)).AND.
$ (.NOT.INTCHK))THEN
C
C--- linear interpolation to give estimate of mosaicity
C
MOSNEW = ETASTEP(III-1)+ETASTEP(2)*
$ (INTMIN-NINT(SCALE*
$ INTTOT(III-2-(NSTEP),IYZ)))/
$ (NINT(SCALE*INTTOT(III-1-(NSTEP),IYZ)-
$ (NINT(SCALE*
$ INTTOT(III-2-(NSTEP),IYZ)))))
MOSNEW = (NINT(MOSNEW * 100.0))/100.0
INTCHK = .TRUE.
ENDIF
1342 ENDDO
ENDIF
C
C---- if the mosaicity is largish, we need to expand the range that we test.
C Only do this up to 4 degrees!
C
IF(MOSNEW.GT.0.4*ETAMAX.AND.MOSEST)THEN
IF(ETAMAX.LT.4.0)THEN
ETAMAX = ETAMAX*2.0
DELETA = DELETA*2.0
INTCHK = .FALSE.
GOTO 1341
ELSE
MOSNEW = 999.0
ENDIF
ENDIF
MOSEST = .FALSE.
C
C---- must set INTCHK anyway
C
INTCHK = .TRUE.
IF (ONLINE) THEN
IF (REFETA) DELPSI = DELETA
WRITE (ITOUT,FMT=6032) PSISTR(IFLAG),DELPSI
6032 FORMAT (/,' Refining ',A,' with stepsize',F6.2,' Degrees')
IF (REFETA) THEN
WRITE(ITOUT,FMT=6037) (ETASTEP(JSTEP),
+ JSTEP=1,2*NSTEP+1)
WRITE(ITOUT,FMT=6039) (NGL(ISTEP),ISTEP = -NSTEP,NSTEP)
ELSE
WRITE(ITOUT,FMT=6033) (ISTEP,ISTEP = -NSTEP,NSTEP)
WRITE(ITOUT,FMT=6034) (NGL(ISTEP),ISTEP = -NSTEP,NSTEP)
END IF
WRITE(ITOUT,FMT=6035) (NINT(SCALE*INTTOT(ISTEP,IYZ)),
+ ISTEP = -NSTEP,NSTEP)
WRITE(ITOUT,FMT=6036) (NINT(SCALE*ISDTOT(ISTEP,IYZ)),
+ ISTEP = -NSTEP,NSTEP)
6033 FORMAT(1X,'Step number ',19I6)
6037 FORMAT(1X,'Divergence ',19F6.3)
6034 FORMAT(1X,'No gained/lost ',19I6)
6039 FORMAT(1X,'No gained ',19I6)
6035 FORMAT(1X,'Total intensity',19I6)
6036 FORMAT(1X,'SD of intensity',19I6)
ENDIF
IF(DEBUG(30))THEN
write(iout,*)'here are the values'
write(iout,fmt=666)(ETASTEP(ISTEP+NSTEP+1),
+ NINT(SCALE*INTTOT(ISTEP,IYZ)),
+ ISTEP = -NSTEP,NSTEP)
666 format(F8.3,1X,I6)
endif
C
C
IF (.NOT.REFETA) WRITE (ITOUT,FMT=6038) IS,X,PSISTR(IFLAG),
+ SPSI(IYZ),SPSI(IYZ) + X*DELPSI,X*DELPSI
6038 FORMAT (/,' Optimum step number is ',I3,' Median shift',F5.1,
+ /1X,A,' Old value ',F7.2,' New value ',F7.2,
$ ' SHIFT',F6.2)
C
C
WRITE (IOUT,FMT=6032) PSISTR(IFLAG),DELPSI
IF (REFETA) THEN
WRITE(IOUT,FMT=6037) (ETASTEP(JSTEP),
+ JSTEP=1,2*NSTEP+1)
WRITE(IOUT,FMT=6039) (NGL(ISTEP),ISTEP = -NSTEP,NSTEP)
ELSE
WRITE(IOUT,FMT=6033) (ISTEP,ISTEP = -NSTEP,NSTEP)
WRITE(IOUT,FMT=6034) (NGL(ISTEP),ISTEP = -NSTEP,NSTEP)
END IF
WRITE(IOUT,FMT=6035) (NINT(SCALE*INTTOT(ISTEP,IYZ)),
+ ISTEP = -NSTEP,NSTEP)
WRITE(IOUT,FMT=6036) (NINT(SCALE*ISDTOT(ISTEP,IYZ)),
+ ISTEP = -NSTEP,NSTEP)
C
C
IF (.NOT.REFETA) THEN
WRITE (IOUT,FMT=6038) IS,X,PSISTR(IYZ),
+ SPSI(IYZ),SPSI(IYZ) + X*DELPSI,X*DELPSI
C
C---- Update psi angle to optimum value
C
SPSI(IYZ) = SPSI(IYZ) + X*DELPSI
SHPSI(IYZ) = SHPSI(IYZ) + X*DELPSI
PSI(IYZ) = SPSI(IYZ)
END IF
210 CONTINUE
C
C---- End of loop over two psi angles OR divergences
C
220 CONTINUE
C
C---- End of loop over passes
C
IF (REFETA) GOTO 250
C
C---- Convert psi to phi
C
C ****************************
CALL PSITOPHI(SPSI,RDELPHI,PHIAV)
C ****************************
C
IF (ONLINE) WRITE (ITOUT,FMT=6040) SPSI,RDELPHI
6040 FORMAT (/,' FINAL Refined Missetting angles ',/1X,'in PSI',3F8.3,
+ /1X,'in PHI',3F8.3)
WRITE (IOUT,FMT=6040) SPSI,RDELPHI
C
C---- Update stored DELPHI values
C
DO 230 I = 1,3
DELPHI(I) = RDELPHI(I)
230 CONTINUE
C
C---- If shift in psix or psiy gt 0.6 degrees or rconv/2
C or if the sum of the three shifts is greater than
C 1.5 degrees or rconv/2, then
C repeat centrs and refinement at this resolution.
C
SHIFTM = MAX(SHPSI(1),SHPSI(2))
SHIFTT = ABS(SHPSI(1)) + ABS(SHPSI(2)) + ABS(SHPSI(3))
SHMAXM = MIN(0.5*RCONV,0.75)
SHMAXT = MIN(0.5*RCONV,1.5)
C
C
IF ((SHIFTM.GE.SHMAXM) .OR. (SHIFTT.GT.SHMAXT)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6044) SHIFTM,SHIFTT,SHMAXM,SHMAXT
6044 FORMAT (/,' MAX Shift in PSIX,PSIY of',F6.2,' or TOTAL Shift of',
+ F6.2,' Degrees is greater than allowed limits of ',F6.2,
+ ' and',F6.2,' Degrees',/1X,'Repeat refinement using new o',
+ 'rientation')
WRITE (IOUT,FMT=6044) SHIFTM,SHIFTT,SHMAXM,SHMAXT
IF (NOCENT) GO TO 110
GO TO 20
END IF
C
C---- Repeat at higher resolution if required
C
IF ((RESOL2.NE.0.0) .AND. (RESOL2.NE.RESOL1)) THEN
C
C---- Assume current solution is correct to within 2.0 steps
C
IF (ONLINE) WRITE (ITOUT,FMT=6046) RESOL2
6046 FORMAT (//1X,'Repeat orientation refinement with resolution exte',
+ 'nded to',F5.1,' Angstroms')
WRITE (IOUT,FMT=6046) RESOL2
RCONV = 2.0*DELPSI
RESOL1 = RESOL2
C
C---- If total shift is greater than 0.25 degrees, since last CENTRS
C repeat CENTRS
C
SHIFT = 0.0
C
C
DO 240 I = 1,3
SHIFT = ABS(RDELPHI(I)-XDELPHI(I)) + SHIFT
240 CONTINUE
C
C
IF (SHIFT.GT.0.25 .AND. (.NOT.NOCENT)) THEN
C
C---- Calculate resolution based on 'limit'
C
R = LIMIT*1.4142
IF (VEE) R = SQRT(LIMIT**2+VLIM**2)
TH = ATAN(R/XTOFD)*0.5
R = 0.5*WAVE/SIN(TH)
IYZ = 0
ETANEW = RCONV
C
C *******************************
CALL NEWLIST(ETANEW,PSI,PHIAV,R,IYZ)
C *******************************
C
IF (ONLINE) WRITE (ITOUT,FMT=6048) SHIFT
6048 FORMAT (/,' Total shift of',F6.2,' Degrees requires NEW CENTRS ',
+ 'Refinement')
WRITE (IOUT,FMT=6048) SHIFT
C
C
IF (DEBUG(30)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6050) NSPOT,ETANEW,R
6050 FORMAT (1X,I5,' Reflections generated with MOSAIC SPREAD set to',
+ F5.2,' To resolution limit of',F5.1,' Angstroms')
WRITE (IOUT,FMT=6050) NSPOT,ETANEW,R
END IF
C
C---- Initialise variables. Still have to allow partials because
C enlarged mosaic spread means that there may not be enough
C fully recorded reflections in central region
C
PARTLS = .TRUE.
MINREF = 20
GO TO 40
END IF
C
C---- Do not repeat CENTRS if shift less than 0.25
C
GO TO 110
END IF
C
C---- Do beam divergence refinement if required
C
IF (RMOSAIC) THEN
REFETA = .TRUE.
GOTO 110
END IF
C
C---- reset divergences, resolution and mosaic spread
C
250 ETA = SETA
DIVH = SDIVH
DIVV = SDIVV
DSTMAX = DSTMAXS
C
C
999 CONTINUE
RETURN
END
C== BADSPOT ==
C
SUBROUTINE BADSPOT(IRECG,BADTOG,IERR)
C
C---- Changes status of a reflection, bad to good and vice-versa.
C Don't allow change for overloads or off edge reflections.
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER IRECG,IERR
LOGICAL BADTOG
C ..
C .. Array Arguments ..
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER IFLAG
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
EXTERNAL GETHKL,ASUGET
C ..
C .. Extrinsic Functions ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C ..
C .. Equivalences ..
C ..
SAVE
C
IERR = 0
IF (IRECG.LE.0) RETURN
IFLAG = IGFLAG(IRECG)
IF ((ABS(IFLAG).EQ.32).OR.(ABS(IFLAG).EQ.64)) THEN
IERR = ABS(IFLAG)
RETURN
END IF
IF (IFLAG.LT.0) THEN
C
C---- Convert bad spot to OK
C
IGFLAG(IRECG) = 1
BADTOG = .TRUE.
ELSE
C
C---- Convert good spot to bad
C
IGFLAG(IRECG) = -128
BADTOG = .FALSE.
END IF
RETURN
END
C== BELL ==
C
C
C
SUBROUTINE BELL
C ===============
C
C
C
C
C .. Local Scalars ..
CHARACTER PING*1
C ..
C .. Intrinsic Functions ..
INTRINSIC CHAR
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
SAVE
C ..
C
C
PING = CHAR(7)
WRITE (ITOUT,FMT='(1X,A)') PING
C
C
END
C== BESTMASK ==
SUBROUTINE BESTMASK(OD,LRAS,NPBOX,MODE,PQSUMS,MASKREJ,BGKSIG,
+ IFLAG,CTOT,NRXMIN,NRYMIN,NCMIN,LTOL)
C =================================================================
IMPLICIT NONE
C
C---- Finds the optimum background rim and corner cutoff parameters
C for the measurement box suppiled in OD.
C
C OD the measurement box containing the pixel values (input).
C
C LRAS Starting raster parameters: these are updated.
C
C NPBOX The profile box number when called from BGREJECT (MODE=1)
C
C MODE =0 when called from CHKRAS, so there is no list of rejected
C background pixels. In this case inflate BGSIG for first
C two cycles, then use true BGSIG
C =1 when called from BGREJECT from PROCESS, when there is
C a list of rejected pixels. In this case do only two
C cycles and use true BGSIG.
C
C MASKREJ When this subroutine is called from subroutine PROCESS to
C optimise the standard profiles, this array initially
C contains the list of rejected background pixels which
C are overlapped by neighbouring spots as calculated by MASKIT.
C It is UPODATED to include pixels rejected from the background
C plane fit. Note that this is 99 sigma when forming the standard
C profiles so there should not be many !
C
C When called by subroutine CHKRAS to optimise the average
C spot profile for the centre of the image, there is no
C list of rejected pixels.
C
C PQSUMS Contains various sums for the background pixels allowing
C for rejected background pixels. It has been calculated in
C MASKIT for each standard mask, but it is recalculated here
C in calls to SETSM2, and is set to the appropriate values
C for the optimised raster parameters and the merged pixel
C rejection list in a final call to SETSM2
C
C IFLAG is returned as negative if the procedure fails. This is NOT
C YET IMPLEMENTED (It always works !!)
C
C CTOT This is the background plane constant, needed for averaged
C profiles where the background has already been subtracted.
C
C NRXMIN The minimum value for the X-background rim to be used in the
C optimisation. When called from CHKRAS (avergae spot profile
C for centre of image) this is determined by a call to PKRIM.
C When called by BGREJECT (standard profiles) it is 1, and
C a call to CHECKMASK in this S/R is used to reject values.
C
C NRYMIN The minimum value for the Y-background rim to be used in the
C optimisation. See NRXMIN
C
C NCMIN The minimum value for the corner cutoff to be used in the
C optimisation. See NRXMIN
C
C LTOL is the tolerance for this profile
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL BGKSIG,CTOT,LTOL
INTEGER NPBOX,IFLAG,MODE,NRXMIN,NRYMIN,NCMIN
C ..
C .. Array Arguments ..
INTEGER OD(MAXBOX),LRAS(5),MASKREJ(NREJMAX)
REAL PQSUMS(6)
C ..
C .. Local Scalars ..
INTEGER I,J,K,IDR,NREF,NREJ,NRMAX,IPT,NXX,NYY,NRXMAX,NRYMAX,
+ IR,ISDBSI,IBEST,NRMIN,ICYC,NCMAX,ISIGN,IB,NBREJ,N,NTOT,
+ IL,ITOT,NP,NL,NCYCLES,NBADPIX,NBADMAX,IBLAST,IBOPT,HX,HY,
+ IBESTST
LOGICAL FULL,EQUAL
REAL TBGND,TPEAK,SPOTW,BGND,RMSBG,DELX,DELY,AX,
+ SIGFAC,SIGFACMAX,FRAC,SPOTWMAX,BGSIGP,PX,RMSBGN,BGSIGL
C ..
C .. Local Arrays ..
INTEGER MASK(MAXBOX),LMASKREJ(NREJMAX),ISTORE(NREJMAX),
+ LRASSAVE(5)
REAL PQVAL(6),SPOTI(40),PQSUMINV(9),FRACA(40)
CHARACTER STR(3)*3
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL SETMASK2,SETSM2,INTEG3,CHECKMASK,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C
C .. Equivalences ..
EQUIVALENCE (ASPOT(1),SPOTW), (ASPOT(2),BGND),
+ (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(4),DELX), (ASPOT(5),DELY)
C
SAVE
C
DATA STR/'NRX','NRY','NC '/
C
C----- Save the input raster parameters
C
DO 2 I=1,5
LRASSAVE(I) = LRAS(I)
2 CONTINUE
C
C---- First vary the X rim, then do the same for the Y rim.
C
C---- Set corner cutoff to one (effectively no corner cutoff because
C either NRX or NRY is always at least 1. Code in setmask/setmask2
C DOES NOT WORK for NC = 0
C
NXX = LRAS(1)
NYY = LRAS(2)
C
C---- If calling from BGREJECT (ie caled from process to handle the standard
C profiles), set the maximum number of allowed "bad"
C pixels as a function of number of peak pixels of the starting
C raster parameters. "Bad" pixels are those which lie in the peak
C of both the active spot and of a neighbouring spot. This is
C calculated for each combination of raster parameters below in
C a call to CHECKMASK, and those combinations which produce too
C many "bad" pixels are excluded from the optimisation
C
IF (MODE.EQ.1) THEN
CALL SETMASK2(MASK,LRAS,MASKREJ)
CALL SETSM2(MASK,LRAS,PQVAL,PQSUMS,PQSUMINV)
NBADMAX = BADTOL*PQVAL(5)
END IF
NBREJ = MASKREJ(1)
LRAS(3) = 1
C
C---- BGKSIG negative flags background subtracted spots
C
ISIGN = 1
IF (BGKSIG.LT.0.0) ISIGN = -1
BGKSIG = ABS(BGKSIG)
C
C---- Set maximum rim ( *** assumes minimum peak size of 5 pixels ***)
NRXMAX = (NXX-5)/2
NRYMAX = (NYY-5)/2
NCMAX = MIN(NXX,NYY) - 2
FULL = .TRUE.
IDR = 1
NREF = 1
NCYCLES = 2
IF (MODE.EQ.0) NCYCLES = 4
BGSIGL = BGKSIG
C
IF (DEBUG(42)) THEN
NBREJ = MASKREJ(1)
WRITE(IOUT,FMT=6000) NPBOX,MODE,LRAS,NBREJ,(MASKREJ(I),I=2,11)
IF (ONLINE) WRITE(ITOUT,FMT=6000) NPBOX,MODE,LRAS,NBREJ,
+ (MASKREJ(I),I=2,11)
6000 FORMAT(//1X,'Debug output from BESTMASK for box',I3,' MODE=',I3,
+ /,1X,'Starting raster',
+ 5I3,/,1X,'Number rejected background pixels',I4,
+ ' First ten are:',10I4)
END IF
DO 40 ICYC = 1,NCYCLES
C
C---- Set BGSIG depending on MODE and cycle number
C
IF ((MODE.EQ.0).AND.(ICYC.LE.2)) THEN
BGSIGP = 10000.0
ELSE
BGSIGP = BGSIGL
END IF
C
10 IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6002) ICYC,BGSIGP
IF (ONLINE) WRITE(ITOUT,FMT=6002) ICYC,BGSIGP
END IF
6002 FORMAT(/1X,'CYCLE',I3,' For this cycle BGSIG=',F8.1)
C
C---- Vary first Xrim, then Yrim then corner cutoff
C
DO 30 J = 1,3
IF (J.EQ.1) THEN
NRMAX = NRXMAX
NRMIN = NRXMIN
IPT = 4
ELSE IF (J.EQ.2) THEN
NRMAX = NRYMAX
NRMIN = NRYMIN
IPT = 5
ELSE
NRMAX = NCMAX
NRMIN = MAX(NCMIN,1)
IPT = 3
END IF
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6004) STR(J),NRMIN,NRMAX
IF (ONLINE) WRITE(ITOUT,FMT=6004) STR(J),NRMIN,NRMAX
END IF
6004 FORMAT(/1X,'Optimising ',A,' Range',I3,' to',I3,/,1X,' NC RX RY',
+ ' NBG NPK REJ I BKG sigma I/sigma',
+ ' IBEST')
SIGFACMAX = 0.0
SPOTWMAX = -1000000.0
DO 20 IR = NRMIN,NRMAX
LRAS(IPT) = IR
C ************************
C---- Use SETMASK2,SETSM2 which allows for rejected pixels
C
CALL SETMASK2(MASK,LRAS,MASKREJ)
CALL SETSM2(MASK,LRAS,PQVAL,PQSUMS,PQSUMINV)
C
C---- Check, using known spot separations calculated in MASKIT, that
C the current set of parameters does not result in too many peak
C pixels common to this and neighbouring spots being closer to the
C centre of the neighbouring spot than to this one.
C
IF (MODE.EQ.1) THEN
CALL CHECKMASK(MASK,LRAS,NPBOX,NBADPIX)
IF (NBADPIX.GT.NBADMAX) THEN
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6005) IR,NBADPIX,NBADMAX
IF (ONLINE) WRITE(ITOUT,FMT=6005) IR,NBADPIX,NBADMAX
6005 FORMAT(1X,'IR=',I2,' rejected because of',I6,
+ ' bad pixels (closer to an adjacent spot',
+ ' than the current spot (limit is',I4,')')
END IF
C
C---- If this is the first cycle and the rim parameter is getting
C unreasonably large it is probably because the corner rim has been
C set to one, so set IBEST to the input starting and go on to test
C the next rim parameter
C
IF ((ICYC.EQ.1).AND.((IR - LRASSAVE(IPT).GT.2))) THEN
IBEST = LRASSAVE(IPT)
GOTO 24
END IF
SPOTI(IR) = 0.0
GOTO 20
END IF
END IF
C **********************************************
CALL INTEG3(OD(1),LRAS,MASK,PQVAL,PQSUMS,PQSUMINV,NBREJ,
+ LMASKREJ,ISIGN*BGSIGP,DEBUG(42))
C **********************************************
TPEAK = PQVAL(5)
TBGND = PQVAL(6)
C
C---- Get integrated intensity, sigma and I/sigma
C Need TBGND and TPEAK
NREJ = NINT(ASPOT(15))
C
C---- Must update number of background points to allow for rejected
C pixels.
C
TBGND = TBGND - NREJ
C
C
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
SPOTI(IR) = 0.0
GOTO 20
END IF
C
C---- Give debug output if no background pixels and not trapped by above test
C
CAL IF (TBGND.LE.0.0) WRITE(6,*),'****** tbgnd,nrej,tpeak,LRAS,aspot',
CAL + TBGND,
CAL + NREJ,TPEAK,LRAS,ASPOT
C
C---- Calculate standard deviation of intensity
C
C
C
C---- This sigma does not include instrument error correction
C BGND is the total background under the peak, ie
C (number of peak pixels)*c
C If this is an averaged profile (ISIGN.eq.-1), the background has
C been subtracted so need to add it back in.
C
IF (ISIGN.EQ.-1) BGND = TPEAK*CTOT
AX = GAIN*(SPOTW+BGND+BGND*TPEAK/TBGND)
ISDBSI=SQRT(AX) + 0.5
ISDBSI = MAX(ISDBSI,1)
SIGFAC = SPOTW/FLOAT(ISDBSI)
IF (SPOTW.GT.SPOTWMAX) SPOTWMAX = SPOTW
SPOTI(IR) = SPOTW
IF (SIGFAC.GE.SIGFACMAX) THEN
IBEST = IR
SIGFACMAX = SIGFAC
END IF
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6008) (LRAS(K),K=3,5),NINT(TBGND),NINT(TPEAK),
+ NREJ,SPOTW,BGND,ISDBSI,SIGFAC,IBEST
IF (ONLINE) WRITE(ITOUT,FMT=6008) (LRAS(K),K=3,5),NINT(TBGND),
+ NINT(TPEAK),NREJ,SPOTW,BGND,ISDBSI,SIGFAC,IBEST
6008 FORMAT(1X,3I3,3I4,2F12.0,I8,F8.0,I6)
END IF
C
20 CONTINUE
C
C---- Check that it has not rejected all possible raster values
C because too many background points are rejected. This can happen
C if the initial overall dimensions of the measurement box are too
C small.If this is the first cycle then NC will be zero, so just set
C the rim to the smallest value (NRMIN) and keep going
C
IF (SPOTWMAX.EQ.0) THEN
IF (ICYC.EQ.1) THEN
IBEST = NRMIN
GOTO 24
END IF
C
C---- If not the first cycle, increase BGSIGP and try again
C
BGSIGP = 2.0*BGSIGL
BGSIGL = BGSIGP
IF (BGSIGL.GT.200) THEN
WRITE(IOUT,FMT=6013)
IF (ONLINE) WRITE(ITOUT,FMT=6013)
6013 FORMAT(1X,'***** FATAL ERROR *****',/,1X,
+ 'BGSIG too large, check prediction is OK.')
CALL SHUTDOWN
END IF
C
WRITE(IOUT,FMT=6015) BGSIGP
IF (ONLINE) WRITE(ITOUT,FMT=6015) BGSIGP
6015 FORMAT(/,1X,'*** WARNING ***',/,1X,'Too many background ',
+ 'points rejected as outliers to allow',/,1X,
+ 'optimisation. Increasing BGSIG to',F7.1,'(see',
+ ' BACKGROUND kewyord in "Help" library.',/,1X,
+ 'BGSIG will be reset to original value when ',
+ 'integrating images.')
GOTO 10
C
CAL WRITE(IOUT,FMT=6009) LRAS
CAL IF (ONLINE) WRITE(ITOUT,FMT=6009) LRAS
6009 FORMAT(//1X,'***** ERROR *****',/,1X,'With the given raster',
+ ' (measurement box) parameters (',5I3,')',/,1X,'too many ',
+ 'background pixels are being rejected to permit optimisation.',
+ /,1X,'Try increasing the overall box size (NXS,NYS) and rerun',
+ ','/,1X,'but first check (using the graphics option) that the',
+ ' pattern is being',/,1X,'correctly predicted')
CAL CALL SHUTDOWN
END IF
C
C---- Check loss in intensity wrt max for the "best" value. If more
C than "TOL" go up to IBOUND pixels further out in NRX,NRY,or NC
C Initialise IBLAST to 1, so no extrapolation for IBEST occurs
C
IBESTST = IBEST
IBLAST = 0
DO 22 IB = 1,IBOUND
FRAC = ( SPOTWMAX - SPOTI(IBEST) )/SPOTWMAX
FRACA(IB) = FRAC
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6012) IB,FRAC,IBEST
IF (ONLINE) WRITE(ITOUT,FMT=6012) IB,FRAC,IBEST
END IF
6012 FORMAT(1X,'Cycle',I2,' Frac=',F6.3,' IBEST=',I2)
IF (FRAC.GT.LTOL) THEN
IBEST = MAX(IBEST-1,1)
ELSE
IBLAST = IB
GOTO 24
END IF
22 CONTINUE
C
C---- Interpolate between last two values of IB to get the "best" value
C
24 IF (IBLAST.GE.2) THEN
PX = 0.0
IF (FRACA(IBLAST).LT.FRACA(IBLAST-1))
+ PX = (LTOL - FRACA(IBLAST))/(FRACA(IBLAST-1)-FRACA(IBLAST))
IBEST = NINT(REAL(IBEST) + PX)
C
C---- Do not allow IBEST to go beyond IBOUND
C
IF ((IBESTST-IBEST).GT.(IBOUND-1)) IBEST = IBEST + 1
ELSE IF (IBLAST.EQ.1) THEN
C
C---- The BEST value also has frac,tol so just choose it
C IBEST should be incremented by one.
C
CONTINUE
ELSE IF (IBLAST.EQ.0) THEN
C
C---- All possible values have given frac > tol. See if
C IBEST should be incremented by one.
C
PX = (FRACA(IBOUND-1) - FRACA(IBOUND))
IF (ABS((FRACA(IBOUND) - PX) - LTOL) .GT.
+ ABS(FRACA(IBOUND) - LTOL)) IBEST = IBEST + 1
END IF
C
C
C---- If this is the first cycle, decrease IBEST for NC by one, otherwise
C can get poor discrimination in NX and NY in next cycle
C if NC is overestimated. However, only do this if frac was < tol
C
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6011) LTOL,IBEST
IF (ONLINE) WRITE(ITOUT,FMT=6011) LTOL,IBEST
6011 FORMAT(1X,'After interpolation, final IBEST for TOL=',F5.3,
+ ' is',I3)
END IF
CAL IF ((J.EQ.3).AND.(ICYC.EQ.1).AND.(IBLAST.GT.0)) THEN
CAL IBEST = IBEST - 1
CAL IF (DEBUG(42)) THEN
CAL WRITE(IOUT,FMT=6013) IBEST
CAL IF (ONLINE) WRITE(ITOUT,FMT=6013) IBEST
CAL 6013 FORMAT(1X,'Because this is NC and first cycle, IBEST',
CAL + ' reset to',I3)
CAL END IF
CAL END IF
C
26 LRAS(IPT) = IBEST
30 CONTINUE
C
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6010) ICYC,LRAS,FRAC
IF (ONLINE) WRITE(ITOUT,FMT=6010) ICYC,LRAS,FRAC
END IF
6010 FORMAT(1X,'Final raster parameters for cycle',I3,' are',5I4,
+ ' Frac was',F6.3)
40 CONTINUE
CAL IF (DEBUG(42)) THEN
CAL DEBUG(33) = .TRUE.
CAL DEBUG(34) = .TRUE.
CAL SPOT = .TRUE.
CAL END IF
C
C---- Make final call to INTEG with optimum parameters so that MASKREJ,
C PQSUMS are correctly set up
C
C ************************
C---- Use SETMASK2,SETSM2 which allows for rejected pixels
C
CALL SETMASK2(MASK,LRAS,MASKREJ)
CALL SETSM2(MASK,LRAS,PQVAL,PQSUMS,PQSUMINV)
CALL INTEG3(OD(1),LRAS,MASK,PQVAL,PQSUMS,PQSUMINV,NBREJ,
+ LMASKREJ,ISIGN*BGSIGP,DEBUG(42))
C **********************************************
C
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6018) ASPOT,PQSUMS
IF (ONLINE) WRITE(ITOUT,FMT=6018) ASPOT,PQSUMS
6018 FORMAT(1X,'Final values in ASPOT',/,1X,9F12.0,/,1X,9F12.0,
+ /,1X,'Current PQSUMS ',9F12.0)
CAL DEBUG(33) = .FALSE.
CAL DEBUG(34) = .FALSE.
CAL SPOT = .FALSE.
END IF
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
IF (BRIEF) WRITE(IBRIEF,6020) BGSIGP,NBGMIN
WRITE(IOUT,6020) BGSIGP,NBGMIN
IF (ONLINE) WRITE(ITOUT,6020) BGSIGP,NBGMIN
6020 FORMAT(//1X,'With the current BGSIG factor of',F6.2,
+ ' there are fewer than ',I3,' background pixels remaining',
+ /,1X,'for this profile after rejecting outliers',/,1X,
+ 'Check if things are seriously wrong or rerun ',
+ 'with a larger value for BGSIG ',/,1X,
+ 'on BACKGROUND keyword')
CALL SHUTDOWN
END IF
C
C---- Now calculate a new RMSBG (used to test if standard profile needs
C averaging) omitting background points next to peak pixels or next
C to overlapped background pixels
C
HX = LRAS(1)/2
HY = LRAS(2)/2
CALL NEWRMS(OD,HX,HY,MASK,LMASKREJ,RMSBGN)
IF (RMSBGN.NE.0) RMSBG = RMSBGN
C
C---- Now have to merge the list of rejected pixels due to overlap of
C neighbouring reflections (Stored in MASKREJ) with the list
C of pixels which deviate from the beast background plane (stored in
C LMASKREJ)
C
NBREJ = MASKREJ(1)
NREJ = LMASKREJ(1)
I = 0
IL = 0
NTOT = 0
C
C---- Set EQUAL true so that on first entry it assigns both I and IL
C
EQUAL = .TRUE.
50 I = I + 1
IF (I.GT.NBREJ) GOTO 60
NP = MASKREJ(I+1)
IF (.NOT.EQUAL) GOTO 54
52 IL = IL + 1
IF (IL.GT.NREJ) GOTO 64
EQUAL = .FALSE.
NL = LMASKREJ(IL+1)
54 NTOT = NTOT + 1
IF (NL.LT.NP) THEN
ISTORE(NTOT+1) = NL
GOTO 52
ELSE IF (NP.LT.NL) THEN
ISTORE(NTOT+1) = NP
GOTO 50
ELSE
ISTORE(NTOT+1) = NL
EQUAL = .TRUE.
GOTO 50
END IF
C
C----Gets here if list in MASKREJ is exhausted first
C If the last two pixels had the same number, need to increment IL
C by one before copying rest of list. Note this also deals with the
C case when NBREJ=0, because EQUAL is initialised to be TRUE.
C
60 IF (EQUAL) IL = IL + 1
IF (IL.GT.NREJ) GOTO 68
DO 62 J = IL,NREJ
NTOT = NTOT + 1
ISTORE(NTOT+1) = LMASKREJ(J+1)
62 CONTINUE
GOTO 68
C
C----Gets here if list in LMASKREJ is exhausted first
C
64 DO 66 J = I,NBREJ
NTOT = NTOT + 1
ISTORE(NTOT+1) = MASKREJ(J+1)
66 CONTINUE
C
68 ISTORE(1) = NTOT
C
IF (DEBUG(42)) THEN
WRITE(IOUT,FMT=6030) NBREJ
IF (NBREJ.NE.0) WRITE(IOUT,FMT=6031) (MASKREJ(I),I=2,NBREJ+1)
WRITE(IOUT,FMT=6032) NREJ
IF (NREJ.NE.0) WRITE(IOUT,FMT=6031) (LMASKREJ(I),I=2,NREJ+1)
WRITE(IOUT,FMT=6034) NTOT
IF (NTOT.NE.0) WRITE(IOUT,FMT=6031) (ISTORE(I),I=2,NTOT+1)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=6030) NBREJ
IF (NBREJ.NE.0) WRITE(ITOUT,FMT=6031)
+ (MASKREJ(I),I=2,NBREJ+1)
WRITE(ITOUT,FMT=6032) NREJ
IF (NREJ.NE.0) WRITE(ITOUT,FMT=6031)
+ (LMASKREJ(I),I=2,NREJ+1)
WRITE(ITOUT,FMT=6034) NTOT
IF (NTOT.NE.0) WRITE(ITOUT,FMT=6031)
+ (ISTORE(I),I=2,NTOT+1)
END IF
END IF
6030 FORMAT(1X,'Number of rejected pixels in MASKREJ',I4)
6031 FORMAT(1X,' Values:',
+ /,(1X,30I4))
6032 FORMAT(1X,'Number in LMASKREJ',I4)
6034 FORMAT(1X,'Number after merging',I4)
C
C
DO 70 I = 1,NTOT+1
MASKREJ(I) = ISTORE(I)
70 CONTINUE
C
C---- Now need to set up PQSUMS to reflect the merged rejected pixel list
C This is returned to BGREJECT.
C
CALL SETMASK2(MASK,LRAS,MASKREJ)
CALL SETSM2(MASK,LRAS,PQVAL,PQSUMS,PQSUMINV)
C WRITE(6,*),'End of BESTMASK, number rej, PQSUMS',MASKREJ(1),PQSUMS
RETURN
END
C== BEXPAN4 ==
C
SUBROUTINE BEXPAN4(A,IA,NXY)
C ===========================
C
C This version for image plate data (I*2 pixel values)
C It simply transfers values from array A to array IA (where A is
C I*2 but IA is I*4). Note that this differs from BEXPAN only in that
C the output array is I*4 rather than I*2. Two versions are required
C because subroutine CGFIND called from CENTRS does a sort on the pixel
C values and the sort routine expects I*2 arrays because it deals with
C primarily with the generate file data. However in CGFIT we want to use
C the BGTEST and BGSOLVE subroutines to eliminate bad background pixels
C and these require I*4 arrays.
C If the dynamic range is extended to 16 bits we must cope
C with the fact that values will be unsigned
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER NXY
C ..
C .. Array Arguments ..
INTEGER*2 A(NXY)
INTEGER IA(NXY)
C ..
C .. Local Scalars ..
INTEGER I
INTEGER*2 IOD
C ..
C .. Extrinsic Functions ..
INTEGER INTPXL
EXTERNAL INTPXL
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C ..
SAVE
C
C
DO 10 I = 1,NXY
IOD = A(I)
IA(I) = INTPXL(IOD)
10 CONTINUE
END
C== BGREJECT ==
SUBROUTINE BGREJECT(OD,MASK,LRAS,NPBOX,MASKREJ,PQVAL,PQSUMS,
+ PQSUMINV,BGKSIG,CHANGEMASK,FULL,NRBX,IOPTRAS,CTOT,LTOL,
+ DENSE)
C ===============================================================
C
IMPLICIT NONE
C
C
C****** DEBUG(24) FOR THIS SUBROUTINE ******
C
C---- MASK and LRAS are updated by this subroutine if raster optimisation
C is requested (PROPT true)
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
INTEGER NRBX,NPBOX
REAL BGKSIG,CTOT,LTOL
LOGICAL CHANGEMASK,FULL,DENSE
C ..
C .. Array Arguments ..
REAL PQSUMINV(9),PQSUMS(6),PQVAL(6)
INTEGER LRAS(5),MASK(MAXBOX),MASKREJ(NREJMAX),OD(MAXBOX),
+ IOPTRAS(3)
C ..
C .. Local Scalars ..
REAL SCALE
INTEGER K,NBREJ,NXX,NYY,NXY,IFLAG,NREJ,I,IL,NTOT,NP,NL,J,MODE,
+ IHX,IHY,NRXMIN,NRYMIN,NCMIN,IMODE,MAXPIX
LOGICAL EQUAL
C ..
C .. Local Arrays ..
INTEGER LMASKREJ(NREJMAX),ISTORE(NREJMAX)
REAL SPOTPQSUM(6)
C ..
C .. External Subroutines ..
EXTERNAL PQINV,BESTMASK,SETMASK,SETSUMS,INTEG,ODPLOT4,PKRIM
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C ..
SAVE
MAXPIX = 0
C
C
C---- If not enough background pixels left, get some more !
C
C
IF ((NINT(PQSUMS(6)).LT.RECLEVEL*NBGMIN)
+ .AND.(RECOVER)) THEN
CALL GETMOREBG(OD,LRAS,MASK,MASKREJ,PQSUMS,PQSUMINV,NPBOX)
END IF
C---- Copy pqsums to a local array because they will be updated in
C BGTEST called from EVAL called from INTEG.
C
DO 10 K = 1,6
SPOTPQSUM(K) = PQSUMS(K)
10 CONTINUE
IF (PROPT) THEN
C
C---- Get optimised raster box parameters (rim and corner cutoff)
C This S/R also gets rejected points
MODE = 1
C
C---- First see if neighbouring spots intrude
C
IHX = LRAS(1)/2
IHY = LRAS(2)/2
IMODE = 1
CALL PKRIM(OD,CTOT,IHX,IHY,IMODE,NRXMIN,NRYMIN,NCMIN)
C
C
C---- While testing CHECKMASK set all min values to 1
C
NRXMIN = 1
NRYMIN = 1
NCMIN = 1
C
C---- If working in DENSE mode, limit allowable change in rim parameters
C
IF (DENSE) THEN
NRXMIN = MAX(LRAS(4) - 2,1)
NRYMIN = MAX(LRAS(5) - 2,1)
NCMIN = MAX(LRAS(3) - 2,1)
END IF
CALL BESTMASK(OD(1),LRAS,NPBOX,MODE,SPOTPQSUM,MASKREJ(1),
+ BGKSIG,IFLAG,CTOT,NRXMIN,NRYMIN,NCMIN,LTOL)
IOPTRAS(1) = LRAS(3)
IOPTRAS(2) = LRAS(4)
IOPTRAS(3) = LRAS(5)
C
C---- Must update PQSUMS to reflect the optimised mask, irrespective of
C whether we are using CHANGEMASK option
C
C **********************************
CALL SETMASK(MASK(1),LRAS)
CALL SETSUMS(MASK(1),LRAS,PQVAL)
C **********************************
C
C---- Set up background sums for this box
C
PQSUMS(1) = PQVAL(2)
PQSUMS(2) = PQVAL(4)
PQSUMS(6) = PQVAL(6)
C
C
ELSE
C
C---- *****************************************************************
C---- Not optimising raster parameters. Still use rejected pixel list
C of calculated overlap from MASKIT
C---- *****************************************************************
C
C---- Use SETMASK2,SETSM2 which allows for rejected pixels
C
C ***************************************************
NBREJ = MASKREJ(1)
CALL SETMASK2(MASK,LRAS,MASKREJ)
CALL SETSM2(MASK,LRAS,PQVAL,SPOTPQSUM,PQSUMINV)
CALL INTEG3(OD(1),LRAS,MASK,PQVAL,SPOTPQSUM,PQSUMINV,NBREJ,
+ LMASKREJ,BGKSIG,DEBUG(24))
C ***************************************************
C
C---- Now have to merge the list of rejected pixels due to overlap of
C neighbouring reflections (Stored in MASKREJ) with the list
C of pixels which deviate from the best background plane (stored in
C LMASKREJ)
C
NBREJ = MASKREJ(1)
NREJ = LMASKREJ(1)
I = 0
IL = 0
NTOT = 0
C
C---- Set EQUAL true so that on first entry it assigns both I and IL
C
EQUAL = .TRUE.
50 I = I + 1
IF (I.GT.NBREJ) GOTO 60
NP = MASKREJ(I+1)
IF (.NOT.EQUAL) GOTO 54
52 IL = IL + 1
IF (IL.GT.NREJ) GOTO 64
EQUAL = .FALSE.
NL = LMASKREJ(IL+1)
54 NTOT = NTOT + 1
IF (NL.LT.NP) THEN
ISTORE(NTOT+1) = NL
GOTO 52
ELSE IF (NP.LT.NL) THEN
ISTORE(NTOT+1) = NP
GOTO 50
ELSE
ISTORE(NTOT+1) = NL
EQUAL = .TRUE.
GOTO 50
END IF
C
C----Gets here if list in MASKREJ is exhausted first
C If the last two pixels had the same number, need to increment IL
C by one before copying rest of list. Note this also deals with the
C case when NBREJ=0, because EQUAL is initialised to be TRUE.
C
60 IF (EQUAL) IL = IL + 1
IF (IL.GT.NREJ) GOTO 68
DO 62 J = IL,NREJ
NTOT = NTOT + 1
ISTORE(NTOT+1) = LMASKREJ(J+1)
62 CONTINUE
GOTO 68
C
C----Gets here if list in LMASKREJ is exhausted first
C
64 DO 66 J = I,NBREJ
NTOT = NTOT + 1
ISTORE(NTOT+1) = MASKREJ(J+1)
66 CONTINUE
C
68 ISTORE(1) = NTOT
C
IF (DEBUG(24)) THEN
WRITE(IOUT,FMT=6030) NBREJ,(MASKREJ(I),I=2,NBREJ+1)
WRITE(IOUT,FMT=6032) NREJ,(LMASKREJ(I),I=2,NREJ+1)
WRITE(IOUT,FMT=6034) NTOT,(ISTORE(I),I=2,NTOT+1)
IF (ONLINE) THEN
WRITE(IOUT,FMT=6030) NBREJ,(MASKREJ(I),I=2,NBREJ+1)
WRITE(IOUT,FMT=6032) NREJ,(LMASKREJ(I),I=2,NREJ+1)
WRITE(IOUT,FMT=6034) NTOT,(ISTORE(I),I=2,NTOT+1)
END IF
END IF
6030 FORMAT(1X,'Number of rejected pixels in MASKREJ',I4,' Values:',
+ /,(1X,30I4))
6032 FORMAT(1X,'Number in LMASKREJ',I4,' Values:',
+ /,(1X,30I4))
6034 FORMAT(1X,'Number after merging',I4,' Values:',
+ /,(1X,30I4))
C
C
DO 70 I = 1,NTOT+1
MASKREJ(I) = ISTORE(I)
70 CONTINUE
C
C---- Now need to set up PQSUMS to reflect the merged rejected pixel list
C
CALL SETMASK2(MASK,LRAS,MASKREJ)
CALL SETSM2(MASK,LRAS,PQVAL,SPOTPQSUM,PQSUMINV)
C
C ******************************************************
C*** CALL INTEG(OD(1),LRAS,MASK(1),PQVAL,1,FULL,BGKSIG,MASKREJ(1),
C*** + SPOTPQSUM,NRBX)
C ******************************************************
END IF
C
C---- If background area of mask is to be changed on basis of
C bad points in the background of the standard profile,
C copy SPOTPQSUM back into PQSUMS
C Also store the inverted matrix for solving for background plane
C when integrating all spots in final pass.
C
NREJ = MASKREJ(1)
C
IF (CHANGEMASK.AND.(NREJ.NE.0)) THEN
C
C
DO 20 K = 1,6
PQSUMS(K) = SPOTPQSUM(K)
20 CONTINUE
C
C ****************************
CALL PQINV(PQSUMS(1),PQSUMINV(1))
C ****************************
C
END IF
C
IF (DEBUG(24)) THEN
NXX = LRAS(1)
NYY = LRAS(2)
IF (SPOT) CALL ODPLOT4(OD(1),NXX,NYY,1,MAXPIX)
IF (ONLINE) WRITE(ITOUT,6000) LRAS,SPOTPQSUM,NREJ,
+ (MASKREJ(K),K=2,NREJ+1)
WRITE(IOUT,6000) LRAS,SPOTPQSUM,NREJ,(MASKREJ(K),K=2,NREJ+1)
6000 FORMAT(/1X,'At end of BGREJECT',/,1X,
+ 'RASTER',5I5,/,1X,'ARRAY SPOTPQSUM ',6F10.0,
+ /,1X,'NUMBER OF REJECTED BACKGROUND',
+ ' POINTS',I4,' NUMBERS',/,(1X,10I5,/))
END IF
C
C
END
C== BGSOLVE ==
SUBROUTINE BGSOLVE(OD,MASK,IRAS,MASKREJ,PQSUMS)
C ===============================================
C
C Solves for the background plane constants after rejecting outliers
C in BGTEST (which also updates the background sums in PQSUMS).
C Evaluates the new rms variation in the background and the largest
C deviation from the new plane (excluding rejected pixels). Thes are
C passed back via ASPOT (as are the plane constants).
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
C
C .. Array Arguments ..
REAL PQSUMS(6)
INTEGER IRAS(5),MASK(MAXBOX),MASKREJ(NREJMAX),OD(MAXBOX)
C ..
C .. Local Scalars ..
REAL A,APC,B,C,DET,DEV,DIFFMAX,RMSBG,SD,SP,SPQ,SQ
INTEGER HX,HY,IJ,NR,P,Q
LOGICAL DEBUG,FINISH
C ..
C .. Local Arrays ..
REAL ABC(3),PQ(3,3),PQINV(3,3),SPQOD(3)
C ..
C .. External Subroutines ..
EXTERNAL MATVEC,MINV33
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(3),RMSBG), (ASPOT(6),SPQOD(1)),
+ (ASPOT(9),ABC(1))
SAVE
C ..
C
C
C
C debug=.true.
C
DEBUG = .FALSE.
C
C
SPQ = PQSUMS(3)
SP = PQSUMS(4)
SQ = PQSUMS(5)
C
C---- Solve for new background plane, now need full 3*3 matrix because
C if points have been rejected the background box will no longer
C be symmetric.
C
PQ(1,1) = PQSUMS(1)
PQ(2,2) = PQSUMS(2)
PQ(3,3) = PQSUMS(6)
PQ(1,2) = SPQ
PQ(2,1) = SPQ
PQ(1,3) = SP
PQ(3,1) = SP
PQ(2,3) = SQ
PQ(3,2) = SQ
C
C ***********************
CALL MINV33(PQINV,PQ,DET)
CALL MATVEC(ABC,PQINV,SPQOD)
C ***********************
C
IF (DEBUG) WRITE (ITOUT,FMT=6000) PQ,PQINV,SPQOD,ABC
C
C---- Reevaluate rmsbg
C
A = ABC(1)
B = ABC(2)
C = ABC(3)
HX = IRAS(1)/2
HY = IRAS(2)/2
IJ = 0
SD = 0.0
NR = 2
DIFFMAX = 0.0
NREJP1 = MASKREJ(1) + 1
FINISH = .FALSE.
C
C
DO 20 P = -HX,HX
APC = A*P + C
DO 10 Q = -HY,HY
IJ = IJ + 1
IF (MASK(IJ).LT.0) THEN
C
C---- Background points
C omit rejected points
C
IF ((.NOT.FINISH).AND.(IJ.EQ.MASKREJ(NR))) THEN
NR = NR + 1
FINISH = (NR.GT.NREJP1)
ELSE
DEV = OD(IJ) - (B*Q+APC)
DIFFMAX = MAX(DIFFMAX,ABS(DEV))
SD = DEV*DEV + SD
END IF
END IF
10 CONTINUE
20 CONTINUE
C
C
IF (DEBUG) THEN
WRITE (IOUT,FMT=6002) NR - 2
WRITE (ITOUT,FMT=6002) NR - 2
END IF
C
C
RMSBG = SQRT(SD/PQSUMS(6))
ASPOT(12) = DIFFMAX
C
C---- Format statements
C
6000 FORMAT (/1X,'MATRIX PQ',9E8.2,/1X,'MATRIX PQINV',9E8.2,/1X,'VECT',
+ 'OR SPQOD ',3E10.2,/1X,'VECTOR ABC',3E10.2,//)
6002 FORMAT (1X,'IN BGSOLVE,',I3,' BACKGROUND POINTS OMITTED')
C
C
END
C== BGSUMS ==
SUBROUTINE BGSUMS(MASK,LMASK,OD,NHX,NHY,PQSUMS,SPQOD)
IMPLICIT NONE
C
C---- Calculate sums for background allowing for overlapped pixels.
C MASK Peak background mask set up by SETMASK
C LMASK Mask where overlapped pixels are non-zero
C OD Array of pixel values
C NHX Box half-width in X
C NHY Box half-width in Y
C PQSUMS:
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY.
C
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C SPQOD Background sums
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NHX,NHY
C ..
C .. Array Arguments ..
INTEGER MASK(MAXBOX),LMASK(MAXBOX),OD(MAXBOX)
REAL PQSUMS(6),SPQOD(3)
C ..
C .. Local Scalars ..
INTEGER IJ,P,Q,IOD
REAL SP,SQ,SPQ,SPP,SQQ,S,SBGOD,SBGPOD,SBGQOD
C
IJ = 0
SP = 0.0
SQ = 0.0
SPQ = 0.0
SPP = 0.0
SQQ = 0.0
S = 0.0
SBGOD = 0.0
SBGPOD = 0
SBGQOD = 0
C
DO 74 P = -NHX,NHX
DO 72 Q = -NHY,NHY
IJ = IJ + 1
IOD = OD(IJ)
C
C---- NOTE: Only consider background pixels for these sums
C
IF ((MASK(IJ).EQ.-1).AND.(LMASK(IJ).EQ.0)) THEN
CAL IF (DEBUG(44).AND.XDEBUG) WRITE(6,*),'P,Q',P,Q
C
C---- Sums for background
C
SBGOD = SBGOD + IOD
SBGPOD = P*IOD + SBGPOD
SBGQOD = Q*IOD + SBGQOD
S = S + 1
SP = P + SP
SQ = Q + SQ
SPP = P*P + SPP
SQQ = Q*Q + SQQ
SPQ = P*Q + SPQ
END IF
72 CONTINUE
74 CONTINUE
PQSUMS(1) = SPP
PQSUMS(2) = SQQ
PQSUMS(3) = SPQ
PQSUMS(4) = SP
PQSUMS(5) = SQ
PQSUMS(6) = S
SPQOD(1) = SBGPOD
SPQOD(2) = SBGQOD
SPQOD(3) = SBGOD
C
RETURN
END
C== BGTEST ==
SUBROUTINE BGTEST(OD,MASK,IRAS,MASKREJ,PQSUMS,BGMAX)
C ====================================================
C
C---- Test background points, reject those more than bgmax from
C least squares plane.
C for rejected points, update background sums in PQSUMS.
C NBREJ is number of background points rejected and is stored
C in MASKREJ(1)
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
C .. Scalar Arguments ..
REAL BGMAX
C ..
C .. Array Arguments ..
REAL PQSUMS(6)
INTEGER IRAS(5),MASK(MAXBOX),MASKREJ(NREJMAX),OD(MAXBOX)
C ..
C .. Local Scalars ..
REAL A,APC,B,C,DEV,SOD,SPOD,SQOD
INTEGER HX,HY,IJ,NBREJ,ODIJ,P,Q
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(6),SPOD), (ASPOT(7),SQOD), (ASPOT(8),SOD),
+ (ASPOT(9),A), (ASPOT(10),B), (ASPOT(11),C)
C ..
SAVE
C
C
HX = IRAS(1)/2
HY = IRAS(2)/2
NBREJ = 0
IJ = 0
C
C
DO 20 P = -HX,HX
APC = A*P + C
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
C
C
IF (MASK(IJ).LT.0) THEN
C
C---- Background points
C
DEV = FLOAT(OD(IJ)) - (B*FLOAT(Q) + APC)
C
C
IF (ABS(DEV).GT.BGMAX) THEN
NBREJ = NBREJ + 1
C
C
IF (NBREJ.GT.NREJMAX-1) THEN
GO TO 30
ELSE
ODIJ = OD(IJ)
MASKREJ(NBREJ+1) = IJ
PQSUMS(1) = PQSUMS(1) - P*P
PQSUMS(2) = PQSUMS(2) - Q*Q
PQSUMS(3) = PQSUMS(3) - P*Q
PQSUMS(4) = PQSUMS(4) - P
PQSUMS(5) = PQSUMS(5) - Q
PQSUMS(6) = PQSUMS(6) - 1
SPOD = SPOD - ODIJ*P
SQOD = SQOD - ODIJ*Q
SOD = SOD - ODIJ
END IF
END IF
END IF
10 CONTINUE
20 CONTINUE
C
C
MASKREJ(1) = NBREJ
RETURN
30 MASKREJ(1) = -999
C
C
END
C== BMATRX ==
C
C
C
SUBROUTINE BMATRX(B,R,C,WAVE)
C =============================
C
C---- Build cell orthogonalization matrix B.
C R are the recip cell parameters
C and C the real cell parameters.
C
C Ref: W.R.Busing & H.A.Levy, Acta Cryst. (1967) 22, 457-464
C
C B = ( a* b* cos gamma* c* cos beta* )
C ( 0 b* sin gamma* -c* sin beta* cos alpha )
C ( 0 0 lambda / c )
C
C
C
C
C
C .. Scalar Arguments ..
REAL WAVE
C ..
C .. Array Arguments ..
REAL B(3,3),C(6),R(6)
C ..
C .. Local Scalars ..
REAL DTOR
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,SIN
C ..
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
B(1,1) = R(1)
B(1,2) = COS(DTOR*R(6))*R(2)
B(1,3) = COS(DTOR*R(5))*R(3)
B(2,1) = 0.0
B(2,2) = SIN(DTOR*R(6))*R(2)
B(2,3) = -SIN(DTOR*R(5))*R(3)*COS(DTOR*C(4))
B(3,1) = 0.0
B(3,2) = 0.0
B(3,3) = WAVE/C(3)
C
C
END
C== BSWAP ==
C
C
SUBROUTINE BSWAP(K1,K2,IP)
C =========================
C
C Image plate version
C---- Moves I*2 words K1:K2 from IMAGE in /PEL/ to IDUM in /PRO/
C starting at IP in IDUM
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IP,K1,K2
C .. Local Scalars ..
INTEGER I1,I2,K
C ..
C .. Common blocks ..
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
C
C
I1 = K1 + IPOINT - 1
I2 = K2 + IPOINT - 1
C
C
DO 10 K = I1,I2
IDUM(IP) = IMAGE(K)
IP = IP + 1
10 CONTINUE
C
C
END
C== BSWAP2 ==
C
SUBROUTINE BSWAP2(K1,K2,IP)
C =========================
IMPLICIT NONE
C
C Image plate version
C---- Moves I*2 words K1:K2 from the next image, stored in array
C IMAGE in /PEL/
C and add them into the values already in IDUM in /PRO/ starting at IP
C in IDUM
C
C This is to allow summation of partially recorded reflections
C from adjoining images.
C
C---- Modify 12/9/81 to allow for extended dynamic range to 64K
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IP,K1,K2
C .. Local Scalars ..
INTEGER I1,I2,K,ISUM,ICOUNT,ICOUNT2,IADD
C ..
C .. Extrinsic Functions ..
INTEGER INTPXL,PUTPXL
EXTERNAL INTPXL,PUTPXL
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
C
C
C Set up the pointer. Note that we are reading from the SECOND image
C here, not the one currently being processed. ISTART is the location
C of the first strip of data for the image currently being processed
C in IMAGE, IADD is the pointer to the first strip of the second image
C
IF (ISTART.EQ.0) THEN
IADD = NREC*IYLEN
ELSE IF (ISTART.EQ.NREC) THEN
IADD = -NREC*IYLEN
END IF
C
C WRITE(6,*),'ISTART,NREC,IYLEN,IADD',ISTART,NREC,IYLEN,IADD
I1 = K1 + IPOINT - 1 +IADD
I2 = K2 + IPOINT - 1 +IADD
C
C
DO 10 K = I1,I2
ICOUNT = INTPXL(IDUM(IP))
ICOUNT2 = INTPXL(IMAGE(K))
ISUM = ICOUNT + ICOUNT2
IDUM(IP) = PUTPXL(ISUM)
IP = IP + 1
10 CONTINUE
C
C
END
SUBROUTINE CBF_INFO(ODFILE,MODEOP)
C
C---- Gets information from a CBF file via Paul Ellis's C routines and
C puts them into a form that FORTRAN programs can deal with.
C
C DEBUG(69) this routine
C
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- arguments
C
INTEGER MODEOP
C
C---- Local scalars
C
INTEGER ID, INDEX
INTEGER I,II,IERR,J,JJ,NSTRIP,CHKSTRP
INTEGER COLUMN, ROW
INTEGER OVERLOAD, DIMENSION(2), PRECEDENCE(2)
CHARACTER DETECTOR
CHARACTER DETECTOR_CHARACTER
CHARACTER DETECTOR_ID(64)
CHARACTER ASL_INDEX(2)
CHARACTER DIRECTION(2), ARRAY_ID, RADIATION
CHARACTER*80 ARGV
CHARACTER*200 ODFILE
INTEGER MAXPIX, MINPIX, MINX, MINY, MAXX, MAXY,pixmin,pixmax,IOD
REAL DTOR,OMEGAFD,TOL
C
C---- The following is used for transferring values between the C stuff
C and Fortran for CBF images
C
C&&*&& include ../inc/cbfinc.f
C
C---- The following are used for transferring values between the C stuff
C and Fortran for CBF images (see wrapper.f for assignments)
C
DOUBLE PRECISION CBF_DOUBLE(16)
INTEGER*4 CBF_INT4(16)
INTEGER CBF_INT(16)
CHARACTER*24 CBF_CHAR(16)
LOGICAL CBF_LOG(16)
COMMON /CBF_PAR/ CBF_DOUBLE,CBF_INT4,CBF_INT,CBF_CHAR,CBF_LOG
C&&*&& end_include ../inc/cbfinc.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C
C Key to contents of arrays (but N.B. these may well change before
C final implementation):
C
C CBF_INT(1) = horizontal direction precedence
C CBF_INT(2) = vertical direction precedence
C CBF_INT(3) = dimension of horizontal pixels
C CBF_INT(4) = dimension of vertical pixels
C CBF_INT(5) = unused so far
C CBF_INT(6) = unused so far
C CBF_INT(7) = unused so far
C CBF_INT(8) = unused so far
C CBF_INT(9) = unused so far
C CBF_INT(10) = unused so far
C CBF_INT(11) = unused so far
C CBF_INT(12) = unused so far
C CBF_INT(13) = unused so far
C CBF_INT(14) = unused so far
C CBF_INT(15) = unused so far
C CBF_INT(16) = unused so far
C
C CBF_INT4(1) = overload value
C
C CBF_DOUBLE(1) = wavelength (Angstroms)
C CBF_DOUBLE(2) = crystal to detector distance (metres)
C CBF_DOUBLE(3) = pixel size in horizontal direction (metres)
C CBF_DOUBLE(4) = pixel size in vertical direction (metres)
C CBF_DOUBLE(5) = detector gain
C CBF_DOUBLE(6) = Oscillation angle about PHI start
C CBF_DOUBLE(7) = Oscillation angle about PHI end
C CBF_DOUBLE(8) = Oscillation angle about PHI range
C CBF_DOUBLE(9) = Polarization ratio of the radiation but unused so far
C CBF_DOUBLE(10) = unused so far
C CBF_DOUBLE(11) = unused so far
C CBF_DOUBLE(12) = unused so far
C CBF_DOUBLE(13) = unused so far
C CBF_DOUBLE(14) = unused so far
C CBF_DOUBLE(15) = unused so far
C CBF_DOUBLE(16) = unused so far
C
C CBF_CHAR(1) = horizontal direction of change (increasing or decreasing)
C CBF_CHAR(2) = vertical direction of change (increasing or decreasing)
C CBF_CHAR(3) = detector name
C CBF_CHAR(4) = oscillation axis (expect PHI!)
C CBF_CHAR(5) = Radiation source (synchrotron, rotating anode...)
C CBF_CHAR(6) = Detector name
C CBF_CHAR(7) = Collimation string but unuseed so far
C CBF_CHAR(8) = unused so far
C CBF_CHAR(9) = unused so far
C CBF_CHAR(10) = unused so far
C CBF_CHAR(11) = unused so far
C CBF_CHAR(12) = unused so far
C CBF_CHAR(13) = unused so far
C CBF_CHAR(14) = unused so far
C CBF_CHAR(15) = unused so far
C CBF_CHAR(16) = unused so far
C
C CBF_LOG(1) = corresponds to INVERTX
C CBF_LOG(2) = unused so far
C CBF_LOG(3) = unused so far
C CBF_LOG(4) = unused so far
C CBF_LOG(5) = unused so far
C CBF_LOG(6) = unused so far
C CBF_LOG(7) = unused so far
C CBF_LOG(8) = unused so far
C CBF_LOG(9) = unused so far
C CBF_LOG(10) = unused so far
C CBF_LOG(11) = unused so far
C CBF_LOG(12) = unused so far
C CBF_LOG(13) = unused so far
C CBF_LOG(14) = unused so far
C CBF_LOG(15) = unused so far
C CBF_LOG(16) = unused so far
PARAMETER(TOL=1.0E-3)
DTOR = ATAN(1.0)*4.0/180.0
I = 1
DO 1010 WHILE (ODFILE(i:i).ne.' ')
I= I + 1
1010 ENDDO
C
C make last character of filename CHAR NULL for the C routines
C
ODFILE(i:i) = char(0)
IERR = 0
CALL CBFWRAP(IERR,CBF_INT,CBF_INT4,CBF_DOUBLE,CBF_CHAR,
$ ODFILE,IMAGE,MODEOP)
IF(MODEOP.EQ.2)THEN
C
C---- call to get image size only; I'm not sure if this is necessary at all
C
NREC = CBF_INT(3)
IYLEN = CBF_INT(4)
ENDIF
IF(IERR.EQ.1)THEN
c WRITE(IOUT,FMT=120)
c IF(ONLINE)WRITE(ITOUT,FMT=120)
c 120 FORMAT('Image file is not in CBF format! I guess its a Mar')
RETURN
ELSE IF(IERR.GT.1)THEN
WRITE(IOUT,FMT=130)
IF(ONLINE)WRITE(ITOUT,FMT=130)
130 FORMAT('CBF file not found!')
ELSE
MACHINE = 'CBF '
MODEL = 'UNKNOWN'
HEADINFO = .TRUE.
USEHDR = .TRUE.
NREC = CBF_INT(3)
IYLEN = CBF_INT(4)
CUTOFF = CBF_INT4(1)
WAVE = CBF_DOUBLE(1)
HWAVE = WAVE
IF(WAVE.GT.0.0)THEN
IIWAVE = .TRUE.
IWAVE = 2
ENDIF
C
C---- distance in MOSFLM is 10 micron units, CBF files have it in metres
C
IF(CBF_DOUBLE(2).NE.-999.0)THEN
XTOFD = CBF_DOUBLE(2)*1E5
HDIST = XTOFD/100.0
IF(XTOFD.GT.0)IDIST = 1
ELSE
WRITE(IOUT,140)
if(ONLINE)WRITE(ITOUT,140)
140 FORMAT('**** WARNING! CBF file does not include ',
$ 'crystal to detector distance! *****')
endif
C
C---- Pixel size, horizontal and vertical, calculate YSCALE
C
IF(CBF_DOUBLE(3).NE.-999.0)THEN
RAST = CBF_DOUBLE(3)
IF(RAST.GT.0)IIRAST = .TRUE.
ELSE
WRITE(IOUT,150)
if(ONLINE)WRITE(ITOUT,150)
150 FORMAT('**** ERROR! CBF file does not include ',
$ 'horizontal pixel size! *****')
endif
IF(CBF_DOUBLE(3).LE.TOL)THEN
WRITE(IOUT,160)CBF_DOUBLE(3)/100
IF(ONLINE)WRITE(ITOUT,160)CBF_DOUBLE(3)/100
160 FORMAT('**** ERROR! CBF file has a horizontal ',
$ 'pixel size which is too small (',F8.4,
$ ' mm')
ELSEIF(CBF_DOUBLE(4).NE.-999.0)THEN
YSCAL = CBF_DOUBLE(4)/CBF_DOUBLE(3)
ELSE
WRITE(IOUT,170)
if(ONLINE)WRITE(ITOUT,170)
170 FORMAT('**** ERROR! CBF file does not include ',
$ 'vertical pixel size! *****')
endif
C
C---- detector gain
C
IF(CBF_DOUBLE(5).NE.-999.0)THEN
GAIN = CBF_DOUBLE(5)
ELSE
WRITE(IOUT,180)
if(ONLINE)WRITE(ITOUT,180)
180 FORMAT('**** WARNING! CBF file does not include ',
$ 'detector gain! *****')
endif
IF((CBF_DOUBLE(6).NE.-999.0).and.
$ (CBF_DOUBLE(7).NE.-999.0).and.
$ (CBF_DOUBLE(8).NE.-999.0))THEN
PHIBEG = CBF_DOUBLE(6)
PHIEND = CBF_DOUBLE(7)
PHIRNG = CBF_DOUBLE(8)
HPHIS = PHIBEG
HPHIE = PHIEND
IF(PHIEND-PHIBEG-PHIRNG.GT.TOL)THEN
WRITE(IOUT,FMT=100)
IF(ONLINE)WRITE(ITOUT,FMT=100)
100 FORMAT('INPUT oscillation angles obtained from the ',
$ 'CBF file contain errors !! Check these values ',
$ 'carefully')
ENDIF
ELSE
WRITE(IOUT,190)
if(ONLINE)WRITE(ITOUT,190)
190 FORMAT('**** WARNING! CBF file does not include ',
$ 'information about the oscillation ',
$ 'range! *****')
endif
C
C---- Polarization not defined yet in imgCIF dictionary
C
C IF(CBF_DOUBLE(7).NE.-999.0)THEN
C TOR = CBF_DOUBLE(7)
C ELSE
C WRITE(IOUT,200)
C if(ONLINE)WRITE(ITOUT,200)
C 200 FORMAT('**** INFORMATION! CBF file does not include ',
C $ 'polarization figure! *****')
C endif
C
C---- now work out OMEGAFD and INVERTX
C
INVERTX = .TRUE.
IF (CBF_CHAR(1).EQ.'increasing')THEN
IF(CBF_CHAR(2).EQ.'increasing')THEN
IF((CBF_INT(1).EQ.1).and.(CBF_INT(2).EQ.2))THEN
C
C---- ORGUR, FASTH
C
OMEGAFD = 0.0
INVERTX = .FALSE.
ELSEIF((CBF_INT(1).EQ.2).and.(CBF_INT(2).EQ.1))THEN
C
C---- ORGUR, FASTV
C
OMEGAFD = 270.0
ELSE
WRITE(IOUT,110)
IF(ONLINE)WRITE(IOUT,110)
CALL SHUTDOWN
110 FORMAT('CBF File has major error!!!',
$ ' Order of vertical and horizontal axes',
$ ' and/or fast/slow axes ',
$ ' is inconsistent!!')
ENDIF
ELSEIF(CBF_CHAR(2).EQ.'decreasing')THEN
IF((CBF_INT(1).EQ.1).and.(CBF_INT(2).EQ.2))THEN
C
C---- ORGLR, FASTH
C
OMEGAFD = 0.0
ELSEIF((CBF_INT(1).EQ.2).and.(CBF_INT(2).EQ.1))THEN
C
C---- ORGLR, FASTV
C
OMEGAFD = 90.0
INVERTX = .FALSE.
ELSE
WRITE(IOUT,110)
IF(ONLINE)WRITE(IOUT,110)
CALL SHUTDOWN
ENDIF
ENDIF
ELSEIF (CBF_CHAR(1).EQ.'decreasing')THEN
IF(CBF_CHAR(2).EQ.'increasing')THEN
IF((CBF_INT(1).EQ.1).and.(CBF_INT(2).EQ.2))THEN
C
C---- ORGUL, FASTH
C
OMEGAFD = 180.0
ELSEIF((CBF_INT(1).EQ.2).and.(CBF_INT(2).EQ.1))THEN
C
C---- ORGUL, FASTV
C
OMEGAFD = 270.0
INVERTX = .FALSE.
ELSE
WRITE(IOUT,110)
IF(ONLINE)WRITE(IOUT,110)
CALL SHUTDOWN
ENDIF
ELSEIF(CBF_CHAR(2).EQ.'decreasing')THEN
IF((CBF_INT(1).EQ.1).and.(CBF_INT(2).EQ.2))THEN
C
C---- ORGLL, FASTH
C
OMEGAFD = 180.0
INVERTX = .FALSE.
ELSEIF((CBF_INT(1).EQ.2).and.(CBF_INT(2).EQ.1))THEN
C
C---- ORGLL, FASTV
C
OMEGAFD = 90.0
ELSE
WRITE(IOUT,110)
IF(ONLINE)WRITE(IOUT,110)
CALL SHUTDOWN
ENDIF
ENDIF
ENDIF
OMEGAF = OMEGAFD * DTOR
C
C----
C
IF(DEBUG(69))THEN
write(iout,fmt=1000)NREC,IYLEN,CUTOFF,WAVE,XTOFD/100,
$ XTOFD,RAST,RAST*YSCAL,GAIN,OMEGAFD,INVERTX
write(itout,fmt=1000)NREC,IYLEN,CUTOFF,WAVE,XTOFD/100,
$ XTOFD,RAST,RAST*YSCAL,GAIN,OMEGAFD,INVERTX
1000 format(80('*'),/,'The image is ',I4,' by ',I4,' pixels ',
$ 'in size with an overload cutoff of ',F8.0,/,'The ',
$ 'wavelength is ',F9.6,' Angstroms, and the ',/,
$ 'crystal to ',
$ 'detector distance is ',F7.2,'mm or ',F9.0,
$ 'microns.'/,'The pixels are ',F8.4,' by ',F8.4,'mm',
$ 'and the detector gain is ',F5.2,/,'Omega is ',F5.1,
$ ' and INVERTX is ',L1,/,/,80('='))
ENDIF
C
C---- Check to see if it's a tiled detector with a stripe
C of nulls which can adversely affect the background measurement in spot-
C finding; for the moment this is only in the middle of a detector with
C stripes across the middle, so if it's swung out this won't adjust
C properly.
C
NSTRIP = 0
NTILEY = 1
NTILEX = 1
CHKSTRP = 0
DO 1030 I=(IYLEN/2)-10,(IYLEN/2)+10,1
IF(IMAGE(I).LE.ICONST.AND.IMAGE(I).GE.0)THEN
IF(CHKSTRP.EQ.I)THEN
C
C---- STRIP ALREADY CHECKED
C
CHKSTRP = I + 1
NSTRIP = 0
ELSE
C
C---- NEW STRIP
C
NSTRIP = 0
DO 1020 J=1,NREC-1,1
JJ = I+IYLEN*J
IF(IMAGE(JJ).LE.ICONST.AND.IMAGE(JJ).GE.0)THEN
NSTRIP = NSTRIP + 1
ENDIF
1020 ENDDO
ENDIF
ENDIF
IF(NSTRIP.GT.0.5*NREC)THEN
NTILEX = NTILEX + 1
CHKSTRP = I+1
ENDIF
1030 ENDDO
CHKSTRP = 0
DO 1050 II=(NREC/2)-10,(NREC/2+10),1
I = II*IYLEN
IF(IMAGE(I).LE.ICONST.AND.IMAGE(I).GE.0)THEN
IF(CHKSTRP.EQ.I)THEN
C
C---- strip already checked
C
CHKSTRP = I + IYLEN
NSTRIP = 0
ELSE
C
C---- new strip
C
NSTRIP = 0
DO 1040 J=1,IYLEN,1
JJ = I+IYLEN
IF(IMAGE(JJ).LE.ICONST.AND.IMAGE(JJ).GE.0)THEN
NSTRIP = NSTRIP + 1
ENDIF
1040 ENDDO
ENDIF
ENDIF
IF(NSTRIP.GT.0.5*NREC)THEN
NTILEY = NTILEY + 1
CHKSTRP = I + IYLEN
ENDIF
1050 ENDDO
IF(NTILEX.GT.1.OR.NTILEY.GT.1)THEN
TILED = .TRUE.
DO 1060 I=1,NTILEX-1,1
TILEX(I)=NREC/NTILEX
TILEWX(I)=10
1060 ENDDO
DO 1070 I=1,NTILEY-1,1
TILEY(I)=NREC/NTILEY
TILEWY(I)=10
1070 ENDDO
ENDIF
ENDIF
RETURN
END
C== CBYTE ==
SUBROUTINE CBYTE(I)
C ===================
C
IMPLICIT NONE
C Image plate version
C---- Get the I'th I*2 word for the current strip (IPOINT'th)
C from IMAGE and pass it back through /PEL/.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER I
C ..
C .. Extrinsic Functions ..
INTEGER INTPXL
EXTERNAL INTPXL
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C ..
SAVE
C
C
IBA = INTPXL(IMAGE(IPOINT+I-1))
C
END
C== CBYTE2 ==
SUBROUTINE CBYTE2(I)
C ====================
IMPLICIT NONE
C
C Image plate version
C---- Get the I'th I*2 word from the ods stored in BOXOD IN /PEL/
C and pass it back through IBA in /PEL/. Note that this calls
C INTPXL2 which applies a non-linearity correction.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER I
C ..
C .. Extrinsic Functions ..
INTEGER INTPXL2
EXTERNAL INTPXL2
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C ..
SAVE
C
C
IBA = INTPXL2(BOXOD(I))
END
C== CELLCHK ==
SUBROUTINE CELLCHK(ICRYST,CELL,IFLAG)
C ======================================
IMPLICIT NONE
C
C---- Check cell is consistent with symmetry. ICRYST values 1 to 8
C corresponds to triclinic to cubic symmetry
C
C
C ..
C .. Scalar Arguments ..
INTEGER IFLAG,ICRYST
C ..
C .. Array Arguments ..
REAL CELL(6)
C ..
C .. Local Scalars ..
INTEGER I
C
IF (ICRYST.EQ.1) THEN
C
C---- Triclinic
C
CONTINUE
ELSE IF (ICRYST.EQ.2) THEN
C
C---- Monoclinic
C
DO 10 I = 4,6,2
IF (ABS(CELL(I)-90.0).GT.0.002) IFLAG = 1
10 CONTINUE
ELSE IF (ICRYST.EQ.3) THEN
C
C---- Orthorhombic
C
DO 20 I = 4,6
IF (ABS(CELL(I)-90.0).GT.0.002) IFLAG = 1
20 CONTINUE
ELSE IF (ICRYST.EQ.4) THEN
C
C---- Tetragonal
C
DO 30 I = 4,6
IF (ABS(CELL(I)-90.0).GT.0.002) IFLAG = 1
30 CONTINUE
IF (ABS(CELL(1)-CELL(2)).GT.0.01) IFLAG = 1
ELSE IF ((ICRYST.EQ.5).OR.(ICRYST.EQ.6)) THEN
C
C---- Trigonal or hexagonal
C
DO 40 I = 4,5
IF (ABS(CELL(I)-90.0).GT.0.002) IFLAG = 1
40 CONTINUE
IF (ABS(CELL(6)-120.0).GT.0.002) IFLAG = 1
IF (ABS(CELL(1)-CELL(2)).GT.0.01) IFLAG = 1
ELSE IF (ICRYST.EQ.7) THEN
C
C---- Cubic
C
DO 50 I = 4,6
IF (ABS(CELL(I)-90.0).GT.0.002) IFLAG = 1
50 CONTINUE
IF (ABS(CELL(1)-CELL(2)).GT.0.01) IFLAG = 1
IF (ABS(CELL(2)-CELL(3)).GT.0.01) IFLAG = 1
IF (ABS(CELL(1)-CELL(3)).GT.0.01) IFLAG = 1
ELSE IF (ICRYST.EQ.8) THEN
C
C---- Rhombohedral cell, rhombohedral rather than hexagonal setting
C
IF (ABS(CELL(1)-CELL(2)).GT.0.01) IFLAG = 1
IF (ABS(CELL(2)-CELL(3)).GT.0.01) IFLAG = 1
IF (ABS(CELL(1)-CELL(3)).GT.0.01) IFLAG = 1
IF (ABS(CELL(4)-CELL(5)).GT.0.01) IFLAG = 1
IF (ABS(CELL(4)-CELL(6)).GT.0.01) IFLAG = 1
IF (ABS(CELL(5)-CELL(6)).GT.0.01) IFLAG = 1
ELSE
C
C---- Unrecognised crystal class
C
IFLAG = 1
END IF
END
C== CELLFIX ==
SUBROUTINE CELLFIX(XCELL)
C ======================================
IMPLICIT NONE
C
C---- Check cell is consistent with symmetry and if not, correct
C it by setting angles to nearest integer and cell edges equal
C
C
C ..
C .. Scalar Arguments ..
C ..
C .. Array Arguments ..
REAL XCELL(6)
C ..
C .. Local Scalars ..
INTEGER I
REAL ANG,D1,D2
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
IF (ICRYST.EQ.1) THEN
C
C---- Triclinic
C
CONTINUE
ELSE IF (ICRYST.EQ.2) THEN
C
C---- Monoclinic
C
DO 10 I = 4,6,2
XCELL(I) = 90.000
10 CONTINUE
ELSE IF (ICRYST.EQ.3) THEN
C
C---- Orthorhombic
C
DO 20 I = 4,6
XCELL(I) = 90.000
20 CONTINUE
ELSE IF (ICRYST.EQ.4) THEN
C
C---- Tetragonal
C
DO 30 I = 4,6
XCELL(I) = 90.000
30 CONTINUE
D1 = (XCELL(1) + XCELL(2))/2.0
XCELL(1) = D1
XCELL(2) = D1
ELSE IF ((ICRYST.EQ.5).OR.(ICRYST.EQ.6)) THEN
C
C---- Trigonal or hexagonal
C
DO 40 I = 4,5
XCELL(I) = 90.00
40 CONTINUE
ANG = XCELL(6)
D1 = ABS(ANG-60.0)
D2 = ABS(ANG-120.0)
IF (D1.LT.D2) THEN
XCELL(6) = 60.00
ELSE
XCELL(6) = 120.0
END IF
D1 = (XCELL(1) + XCELL(2))/2.0
XCELL(1) = D1
XCELL(2) = D1
ELSE IF (ICRYST.EQ.7) THEN
C
C---- Cubic
C
DO 50 I = 4,6
XCELL(I) = 90.00
50 CONTINUE
D1 = (XCELL(1) + XCELL(2) + XCELL(3))/3.0
XCELL(1) = D1
XCELL(2) = D1
XCELL(3) = D1
ELSE IF (ICRYST.EQ.8) THEN
C
C---- Rhombohedral cell, rhombohedral rather than hexagonal setting
C
D1 = (XCELL(1) + XCELL(2) + XCELL(3))/3.0
D2 = (XCELL(4) + XCELL(5) + XCELL(6))/3.0
XCELL(1) = D1
XCELL(2) = D1
XCELL(3) = D1
XCELL(4) = D2
XCELL(5) = D2
XCELL(6) = D2
ELSE
WRITE(IOUT,FMT=6000) ICRYST
IF (ONLINE) WRITE(ITOUT,FMT=6000) ICRYST
6000 FORMAT(//1X,'**** WARNING ****',/,1X,
+ 'Cannot check cell parameters for unknown crystal',
+ ' class',I5)
END IF
END
SUBROUTINE CELLVOL(CELL,CVOL)
C =============================
C
IMPLICIT NONE
C
C
C .. Parameters ..
C
C ..
C .. Scalar Arguments ..
REAL CVOL
C
C ..
C .. Array Arguments ..
REAL CELL(6)
C ..
C .. Local Scalars ..
REAL ALPH,BET,GAMM,SUM,V,DTOR
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
DTOR = ATAN(1.0)*4.0/180.0
ALPH = CELL(4)*DTOR
BET = CELL(5)*DTOR
GAMM = CELL(6)*DTOR
SUM = (ALPH+BET+GAMM)*0.5
V = SQRT(SIN(SUM-ALPH)*SIN(SUM-BET)*SIN(SUM-GAMM)*SIN(SUM))
CVOL = CELL(1)*2.0*CELL(2)*CELL(3)*V
RETURN
END
C== CENTRS ==
SUBROUTINE CENTRS(DOPROFILE,NSIG,IXSHIFT,IYSHIFT,NPROFL,LIMIT,SEP,
+ VLIM,MATCH,PARTLS,OVRLDS,MINREF,OLDLIST,GENLIST,USEBOX,
+ ADDPART,PTMIN)
C ==================================================================
C
C
IMPLICIT NONE
C
C---- Goes through the generate file to
C finds spots suitable for refinement of film centre,
C crystal to film distance and film orientation
C If DOPROFILE is true, an average spot profile is
C accumulated in array IODPROF for display in CHKRAS.
C See comments in main program about selection of spots
C for refinement and for average spot profile on vee films.
C
C MATCH... true: Pattern matching, use limited number of
C reflections (NSPOT)
C
C PARTLS... true: accept partially recorded reflections
C
C OVRLDS... true: accept overloaded reflections
C
C MINREF... minimum acceptable number of reflections to be
C passed to rdist.
C
C OLDLIST.. use a list of reflections compiled in a previous
C call to centrs
C
C GENLIST.. select reflections based on intensities measured
C on previous film in pack
C
C USEBOX.. Apply the measurement box peak/background definition
C when determining centre of gravity, by calling CGFIT
C rather than CGFIND. Usefull if spots are very close.
C
C ADDPART.. True if partials on adjacent images are added together
C during reflection integration.
C In this case, if PARTLS is true, select only those
C partials at end of current image and add in the other
C part of the partial from the next image.
C
C PTMIN... If using partials and NOT summing partials (ADDPART)
C select ONLY reflections with partiality greater than
C PTMIN (range 0 to 1.0)
C---- 12/9/81 Change IWORK to I*4 from I*2, and calls to BEXPAN to BEXPAN4
C to cope with dynamic range up to 64K
C
C Reflection flags (IR) (Set by SPTEST called from DSTAR)
C
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C****** DEBUG(6) FOR THIS SUBROUTINE ******
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL VLIM,SEP,PTMIN
INTEGER IXSHIFT,IYSHIFT,LIMIT,MINREF,NPROFL,NSIG
LOGICAL DOPROFILE,GENLIST,MATCH,OLDLIST,OVRLDS,PARTLS,USEBOX,
+ ADDPART
C ..
C .. Local Scalars ..
REAL AM,AVBKG,AVOD,CALCSIG,CALCVAR,DELX,DELY,ODSIG,ODVAR,
+ SOD,SUMBKG,XC,XCAL,XSIZBIN,YC,YCAL,YSIZBIN,BACK,SDELX,SDELY,
+ SPTMIN,VARTOT,BGND,AJX,AJY,XLIMIT,XDOV2,VXLIMIT
INTEGER HWX,HWY,I,IADDR,IBACK,IBLK,IFRST,IHALF,II,
+ ILAST,IND,INDF,INDL,INDX,INT,ISDR,ISEPN,IIY,J,JADD,JMAX,
+ JREC,JX,JY,K,KMN,KMX,LASTX,LASTY,MAXB,MAXN,MAXW,MINOD,MJ,
+ NBKG,NC,NCLOSE,NJ,NN,NOVER,NPEAK,NPOSS,NPOVER,NREF,NRSOLD,
+ NRX,NRY,NSUM,NWEAK,NXS,NXY,NYS,VLIMIT,NBGBAD,NBGBADG,
+ IPART,NSDRP,IFLAG,NZPBAD,NHX,NHY,IR,IM,NPARTL,NFULLS,
+ NREFT,IR1,IR2
LOGICAL FULL,USEOVRLD,EXPART
C ..
C .. Local Arrays ..
INTEGER ISPOT(100),IWX(500),PNTR(100),IWORK(MAXBOX),X(500),
+ Y(500),IRECNO(500)
INTEGER*2 IARR(MAXBUFF/2)
C ..
C .. External Subroutines ..
EXTERNAL BSWAP,CGFIND,ODPLOT,PXYCALC,RDBLK,SIZRAS,SORTUP3,MMTOPX,
+ BEXPAN4,BSWAP2,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MOD,NINT,REAL,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ovrld.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ovrld.h
C---- START of include file ovrld.h
C
C
C .. Scalars in Common Block /OVRLD/ ..
INTEGER NPMAX
C ..
C .. Common Block /OVRLD/ ..
COMMON /OVRLD/NPMAX
C ..
C
C
C&&*&& end_include ../inc/ovrld.f
C&&*&& include ../inc/params.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file params.h
C---- START of include file params.h
C
C
C .. Scalars in common block /PARAMS/ ..
INTEGER NSDR
C ..
C .. Common Block /PARAMS/ ..
COMMON /PARAMS/NSDR
C ..
C
C
C
C&&*&& end_include ../inc/params.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/pro2.f
C--- awk generated include file pro2.h
C---- START of include file pro2.h
C
C .. Scalars in Common /PRO2/ ..
REAL PRCENSUM
C
C .. Arrays in Common Block /PRO2/ ..
INTEGER IODPROF
C ..
C .. Common Block /PRO2/ ..
COMMON /PRO2/PRCENSUM,IODPROF(MAXBOX)
C ..
C
C
C&&*&& end_include ../inc/pro2.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (IDUM(1),IARR(1))
EQUIVALENCE (ASPOT(11),BACK)
C ..
SAVE
C .. Data statements ..
DATA USEOVRLD/.FALSE./
C ..
C
C
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IR2 = 30*IPAD + 30
EXPART = .FALSE.
XLIMIT = LIMIT
VLIMIT = VLIM
MAXREF = 60
NBGBAD = 0
NBGBADG = 0
NZPBAD = 0
NHX = NXS/2
NHY = NYS/2
C
C---- Find number of background points (needed for cgfind)
C
C ***********************
CALL SIZRAS(IRAS,NPEAK,NBKG)
C ***********************
C
C---- If allowing overloads, set npmax to five times the normal limit
C NOVPIX
C
IF (OVRLDS .OR. USEOVRLD) THEN
IF (NOVPIX.GT.0) THEN
NPMAX = NOVPIX*5
ELSE
NPMAX = 0.25*NPEAK
END IF
ELSE
NPMAX = NOVPIX
END IF
C
C Convert separation from mm to pixels
ISEPN = FACT*SEP*100.0
LASTX = 0
LASTY = 0
XDOV2 = XTOFD*XTOFRA/2.0
C
C
IF (DEBUG(6)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) DOPROFILE,MATCH,PARTLS,
+ OVRLDS,GENLIST,OLDLIST,USEOVRLD,NSPOT,ADDPART,USEBOX,
+ PTMIN
6000 FORMAT (1X,'Enter CENTRS',/1X,'Logicals DOPROFILE ',L1,' MATCH ',
+ L1,' PARTLS ',L1,' OVRLDS ',L1,' GENLIST ',L1,' OLDLIST ',
+ L1,' USEOVRLD ',L1,/,1X,'NSPOT',I5,' ADDPART ',L1,
+ ' USEBOX ',L1,' PTMIN',F5.2)
WRITE (IOUT,FMT=6000) DOPROFILE,MATCH,PARTLS,OVRLDS,GENLIST,
+ OLDLIST,USEOVRLD,NSPOT,ADDPART,USEBOX,PTMIN
END IF
C
C
IF (DOPROFILE) THEN
C
C
DO 10 I = 1,MAXBOX
IODPROF(I) = 0
10 CONTINUE
C
C
NPROFL = 0
END IF
C
C
IF (OLDLIST) GO TO 180
C
C---- If this call is to calculate average spot profile
C use previously stored list of reflections, unless this
C is a vee film, in which case a new list must be created
C Also, if overloads have been included in the positional
C refinement, then we need a new reflection list which excludes
C the overloads.
C
IF ((.NOT.VEE) .AND. DOPROFILE .AND. (.NOT.USEOVRLD)) GO TO 180
C
C---- Start measuring
C
IF (GENLIST) GO TO 90
C
C---- Find full spots from generate file and sort
C
C---- Only use every jadd'th spot if more than 500 reflections
C in central area
C
C---- Set limits for reflection list
C
JMAX = TOSPT
C
C
IF (MATCH) THEN
JMAX = NSPOT
JADD = NSPOT/500
GO TO 30
END IF
C
C
20 JADD = 0
30 JADD = JADD + 1
NREF = 0
NREFT = 0
C
C
DO 80 JREC = 1,JMAX,JADD
C
IR = IRG(JREC)
IM = IMG(JREC)
C
C
IF (PARTLS) THEN
C
C
C---- Reject partials and rejected spots, unless partials have been
C requested.
C If partials are to be included, then if ADDPART is true only
C allow partials at end of current oscillation (IM.GT.0) so they can be
C added in from the next image, if ADDPART is false only
C allow reflections with a degree of partiality greater than PTMIN
C In pattern matching, do NOT apply these tests, and note
C that PTMIN passed in is not the default value but a local variable
C from subroutine automatch set to 0.1
C
IF ((IR.EQ.1).OR.(IR.EQ.2).OR.(IR.EQ.4)) GO TO 80
IF (ADDPART) THEN
IF ((.NOT.MATCH).AND.((IR.LT.IR1).OR.(IR.GT.IR2))
+ .OR.(IM.LT.0)) GOTO 80
ELSE
AM = 0.01*ABS(FLOAT(IM))
IF ((AM.GT.0.0).AND.(AM.LT.PTMIN)) GOTO 80
END IF
ELSE
C
C---- Reject all flagged reflections, don't reject partials yet
C
IF ((IR.NE.0).AND.(IR.LT.IR1)) GO TO 80
END IF
C
C
XC = XG(JREC)
YC = YG(JREC)
C
C---- For precession photographs, XG,YG are multiples of base
C vectors and not reflection coordinates,
C so must calculate coords.
C
IF (PRECESS) THEN
C
C ************************
CALL PXYCALC(XCAL,YCAL,XC,YC)
C ************************
C
AJX = ABS(XCAL-XCEN)
AJY = ABS(YCAL-YCEN)
ELSE
AJX = ABS(XC)
AJY = ABS(YC)
END IF
C
C
IF (DEBUG(6) .AND. JREC.LT.NDEBUG(6)) THEN
IF (ONLINE) WRITE(ITOUT,FMT=6002) JREC,XC,YC,AJX,AJY,XLIMIT,
+ IR,IM
6002 FORMAT (1X,'JREC',I5,' X,Y (GENFILE)',2F8.1,' AJX,Y',2F8.1,
+ ' LIMIT',F7.1,' IR',I3,' IM',I4)
WRITE (IOUT,FMT=6002) JREC,XC,YC,AJX,AJY,XLIMIT,IR,IM
END IF
C
C
IF (AJY.GT.XLIMIT) GO TO 80
C
C---- Test for area containing unexpanded spots for vee-films.
C
IF (VEE) GO TO 40
IF (AJX.GT.XLIMIT) GO TO 80
GO TO 60
40 IF (DOPROFILE) GO TO 50
IF (AJX.GT.VLIMIT) GO TO 80
GO TO 60
C
50 IF (ABS(AJX-XDOV2).GT.XLIMIT) GO TO 80
60 NREFT = NREFT + 1
C
C---- Reject partials now
C
IF ((.NOT.PARTLS).AND.(IM.NE.0)) GOTO 80
NREF = NREF + 1
IRECNO(NREF) = JREC
IF (IM.NE.0) IRECNO(NREF) = -IRECNO(NREF)
C
C ****************************
IF (.NOT.PRECESS) CALL MMTOPX(XCAL,YCAL,XC,YC)
C ****************************
C
C---- Apply box shift. Note that X,Y are spot coordinates in pixels.
C
X(NREF) = NINT(XCAL*FACT) + IXSHIFT
Y(NREF) = NINT(YCAL*FACT) + IYSHIFT
C
C---- Test that the edge of the measurement box is not outside the image
C
IF ((X(NREF)-NHX.LT.6).OR.(X(NREF)+NHX.GT.NREC-5).OR.
+ (Y(NREF)-NHY.LT.6).OR.(Y(NREF)+NHY.GT.IYLEN-5)) THEN
NREF = NREF - 1
GOTO 80
END IF
IF (DEBUG(6).AND.NREF.LT.NDEBUG(6)) THEN
WRITE(IOUT,FMT=6003) NREF,X(NREF),Y(NREF)
IF (ONLINE) WRITE(ITOUT,FMT=6003) NREF,X(NREF),Y(NREF)
6003 FORMAT(1X,'SELECTED REFLECTION',I4,' X,Y',2I8)
END IF
IF (NREF.EQ.500) GO TO 30
80 CONTINUE
C
C
GO TO 200
C
C---- ********** Alternative procedure *************
C For B and C films using NOFID option,
C select spots on basis of intensity measured on preceeding film.
C
90 XSIZBIN = XLIMIT/5.0
YSIZBIN = XLIMIT/4.0
C
C
DO 100 I = 1,60
ISPOT(I) = 0
100 CONTINUE
C
C---- Search for the strongest full spot in each
C subdivision of the film
C
110 CONTINUE
C
C
DO 140 I = 1,TOSPT
C
C---- Reject partials and rejected spots
C
IR = IRG(I)
IM = IMG(I)
IF ((IR.NE.0).OR.(IM.NE.0)) GO TO 130
C
C---- Reject overloads or unmeasured spots on preceeding film
C unless we want to use overloads (but not if forming profile)
C in which case the first overload in the bin is selected
C
INT = INTG(I)
IF (USEOVRLD .AND. (INT.EQ.9999) .AND.
+ (.NOT.DOPROFILE)) GO TO 120
IF (INT.EQ.9999 .OR. INT.LE.0) GO TO 130
120 XC = XG(I)
YC = YG(I)
JX = XC
JY = YC
C
C---- For precession photographs, XG,YG are multiples of
C base vectors and not reflection coordinates,
C so must calculate coords.
C
IF (PRECESS) THEN
C
C ************************
CALL PXYCALC(XCAL,YCAL,XC,YC)
C ************************
C
AJX = ABS(XCAL-XCEN)
AJY = ABS(YCAL-YCEN)
ELSE
AJX = ABS(XC)
AJY = ABS(YC)
END IF
C
C
IF (AJY.GT.XLIMIT) GO TO 130
C
C---- Test for area containing unexpanded spots for vee-films.
C
IF (VEE) THEN
C
C
IF (DOPROFILE) THEN
IF (ABS(AJX-XDOV2).GT.XLIMIT) GO TO 130
ELSE
IF (AJX.GT.VLIMIT) GO TO 130
END IF
C
C
ELSE
IF (AJX.GT.XLIMIT) GO TO 130
END IF
C
C
K = (XLIMIT+XC)/XSIZBIN
IF (PRECESS) K = (XLIMIT+XCAL-XCEN)/XSIZBIN
IF (K.GT.9) K = 9
J = (XLIMIT+YC)/YSIZBIN
IF (PRECESS) J = (XLIMIT+YCAL-YCEN)/YSIZBIN
IF (J.LT.1) J = 1
IF (J.GT.6) J = 6
INDX = 6*K + J
C
C
IF (USEOVRLD .AND. (.NOT.DOPROFILE) .AND. (INT.EQ.9999)) THEN
ISDR = 500
ELSE
ISDR = INT/ISDG(I)
END IF
C
C
IF (ISDR.LT.ISPOT(INDX)) GO TO 130
C
C
IF (DEBUG(6)) THEN
IF (PRECESS) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6004) I,INDX,XG(I),YG(I),
+ NINT(XCAL-XCEN),NINT(YCAL-YCEN),ISDR
6004 FORMAT (1X,'REFLECTION',I5,' INDX',I3,' N,M',2I5,' IX,IY',2I6,
+ ' ISDR',I5)
WRITE (IOUT,FMT=6004) I,INDX,XG(I),YG(I),NINT(XCAL-XCEN),
+ NINT(YCAL-YCEN),ISDR
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6006) I,INDX,XG(I),YG(I),ISDR
6006 FORMAT (1X,'REFLECTION',I5,' INDX',I3,' IX,IY',2F8.1,' ISDR',I5)
WRITE (IOUT,FMT=6006) I,INDX,XG(I),YG(I),ISDR
END IF
END IF
C
C
ISPOT(INDX) = ISDR
IRECNO(INDX) = I
C
C ****************************
IF (.NOT.PRECESS) CALL MMTOPX(XCAL,YCAL,XC,YC)
C ****************************
C
X(INDX) = NINT(XCAL*FACT)
Y(INDX) = NINT(YCAL*FACT)
C
C---- Increase ISPOT for overloads so that first found in bin is kept
C
IF (USEOVRLD .AND. (.NOT.DOPROFILE)) ISPOT(INDX) = 600
130 CONTINUE
140 CONTINUE
C
C---- Count number of spots found and reject those with
C I/SD.lt.NSDR (defaults to 25)
C
IF (DEBUG(6)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6008)
6008 FORMAT (//1X,'Selected reflections in CENTRS')
WRITE (IOUT,FMT=6008)
END IF
C
C
NREF = 0
C
C
DO 170 I = 1,60
C
C---- NSDR set by default to 25, may be changed by keyword ISDR
C
IF (ISPOT(I).LT.NSDR) GO TO 160
NREF = NREF + 1
X(NREF) = X(I)
Y(NREF) = Y(I)
IRECNO(NREF) = IRECNO(I)
C
C
IF (DEBUG(13)) THEN
IF (ONLINE) WRITE(ITOUT,FMT=6010) NREF,X(I),Y(I)
6010 FORMAT (1X,'NREF=',I5,' X,Y',2I6)
WRITE(IOUT,FMT=6010) NREF,X(I),Y(I)
END IF
C
C
160 CONTINUE
170 CONTINUE
C
C---- If not enough reflections, try including reflections that
C are overloaded on the A film, and allow them to be overloaded
C (up to 5*NOVPIX pixels) on this film too.
C
IF ((NREF.LT.MINREF) .AND. (.NOT.USEOVRLD)) THEN
WRITE (IOUT,FMT=6012)
6012 FORMAT (/1X,'** NOT enough reflections found for refinement **',
+ /1X,'Allow inclusion of overloaded reflections')
IF (ONLINE) WRITE (ITOUT,FMT=6012)
USEOVRLD = .TRUE.
IF (NOVPIX.GT.0) THEN
NPMAX = NOVPIX*5
ELSE
NPMAX = 5
END IF
GO TO 110
END IF
C
C
IF (NREF.LT.MINREF) THEN
IF (NSDR.GE.3) THEN
NSDRP = 0.666*NSDR
WRITE (IOUT,FMT=6014) NREF,NSDR,NSDRP
6014 FORMAT (/1X,'ONLY',I3,' Reflections found for refinement in cent',
+ 'ral region of film',/1X,'Cutoff (I/sigma) reduced from',
+ I4,' to',I4)
IF (ONLINE) WRITE (ITOUT,FMT=6014) NREF,NSDR,NSDRP
NSDR = NSDRP
GOTO 110
ELSE
WRITE (IOUT,FMT=6015) NREF,NSDR
IF (ONLINE) WRITE (ITOUT,FMT=6015) NREF,NSDR
6015 FORMAT (/1X,'ONLY',I3,' Reflections found for refinement in ',
+ 'central region of film',/1X,'with cutoff (I/sigma) set to',
+ I3)
NRS = NREF
RETURN
END IF
END IF
C
C
GO TO 200
C
C---- Use existing list of refinement spots
C
180 CONTINUE
C
NPARTL = 0
C
DO 190 I = 1,NRS
JREC = RRS(I)
IRECNO(I) = JREC
IF (JREC.LT.0) THEN
JREC = -JREC
C
C---- Count number of partials in list if forming average spot profile
C
IF (DOPROFILE.AND.(.NOT.ADDPART)) NPARTL = NPARTL + 1
END IF
XC = XG(JREC)
YC = YG(JREC)
C
IF (PRECESS) THEN
C
C ************************
CALL PXYCALC(XCAL,YCAL,XC,YC)
C ************************
C
ELSE
C
C ***********************
CALL MMTOPX(XCAL,YCAL,XC,YC)
C ***********************
C
END IF
C
C
X(I) = NINT(XCAL*FACT) + IXSHIFT
Y(I) = NINT(YCAL*FACT) + IYSHIFT
IF (DEBUG(6)) THEN
WRITE(IOUT,FMT=6017) I,RRS(I),XG(JREC),YG(JREC),X(I),Y(I)
IF (ONLINE) WRITE(ITOUT,FMT=6017) I,RRS(I),XG(JREC),YG(JREC),
+ X(I),Y(I)
6017 FORMAT(1X,'Reflection',I3,' Record number',I6,' XG,YG',2F8.1,
+ ' Pixel coords',2I10)
END IF
190 CONTINUE
C
C
NREF = NRS
C
C---- If forming average spot profile, exclude partials (providing this
C leaves at least MINREF reflections)
C
IF (DOPROFILE) THEN
NFULLS = NREF - NPARTL
EXPART = (NFULLS.GT.MINREF)
IF (.NOT.EXPART) THEN
WRITE(IOUT,FMT=6013) MINREF
IF (ONLINE) WRITE(ITOUT,FMT=6013) MINREF
6013 FORMAT(1X,'Fewer than',I3,' fully recorded reflections, so',
+ ' average spot profile will include partials')
END IF
END IF
C
200 IF (PARTLS) THEN
IF (ADDPART) THEN
WRITE(IOUT,FMT=6050) NREF
IF (ONLINE) WRITE(ITOUT,FMT=6050) NREF
6050 FORMAT(1X,I5,' Fulls and summed partials to be measured')
ELSE IF (PARTLS.AND.EXPART) THEN
WRITE(IOUT,FMT=6052) NREF-NPARTL
IF (ONLINE) WRITE(ITOUT,FMT=6052) NREF-NPARTL
6052 FORMAT(1X,I5,' Fulls to be measured')
ELSE
WRITE(IOUT,FMT=6054) NREF
IF (ONLINE) WRITE(ITOUT,FMT=6054) NREF
6054 FORMAT(1X,I5,' Fulls and partials to be measured')
END IF
ELSE
WRITE(IOUT,FMT=6052) NREF
IF (ONLINE) WRITE(ITOUT,FMT=6052) NREF
END IF
C
C
IF (NREF.LT.MINREF) THEN
C
C---- Too few reflections in the list. If necessary, include partials, but
C first check that this really is because most of the reflections are
C partial. If not, then increase the size of central area.
C
IF (.NOT.PARTLS) THEN
C
C---- If total number (fulls plus partials) > 3*MINREF, then include
C partials
C
IF (NREFT.GE.3*MINREF) THEN
WRITE(IOUT,FMT=6060) NREF,PTMIN,MINREF
IF (ONLINE) WRITE(ITOUT,FMT=6060) NREF,PTMIN,MINREF
6060 FORMAT(/,1X,'**** WARNING ****',/,1X,'There are only',
+ I4,' fully recorded reflections in',/,1X,'the central ',
+ 'region, so partials will be included in refinement.',/,1X,
+ 'This is equivalent to including keywords: REFINEMENT ',
+ 'INCLUDE PARTIALS',F4.1,/,1X,'To avoid including partials',
+ ' you may change the minimum number of reflections',/,1X,
+ '(currently',I3,') using keywords REFINEMENT NREF 12 say,',
+ ' or reduce',/,1X,'the threshold using keywords REFINEMENT',
+ ' NSIG 10 say.')
PARTLS = .TRUE.
GOTO 20
ELSE
C
C---- otherwise expand central limit if possible
C
IF (LIMIT.LT.XMAX) THEN
LIMIT = LIMIT + 500
IF (VEE) VLIMIT = VLIMIT + 500
XLIMIT = LIMIT
VXLIMIT = VLIMIT
WRITE(IOUT,FMT=6063) NREF,NREFT,3*MINREF,2*LIMIT/100
IF (ONLINE) WRITE(ITOUT,FMT=6063) NREF, NREFT, 3*MINREF,
+ 2*LIMIT/100
GOTO 20
6063 FORMAT(/,1X,'***** WARNING ****',/,1X,'Only',I4,' ',
+ 'fully recorded reflections within central region.',/,1X,
+ 'There are only',I5,' reflections even including ',
+ 'partials (which is less than 3*MINREF,',I4,')',/,1X,
+ 'so increas size of central area to',I4,' mm square.')
ELSE
C
C---- Cannot expand limit any further, include partials
C
WRITE(IOUT,FMT=6060) NREF,PTMIN,MINREF
IF (ONLINE) WRITE(ITOUT,FMT=6060) NREF,PTMIN,MINREF
PARTLS = .TRUE.
GOTO 20
END IF
END IF
ELSE
C
C---- IF not using ADDPART, try decreasing PTMIN (to a minimum of 0.01)
C
IF (.NOT.ADDPART) THEN
IF (PTMIN.LE.0.01) THEN
WRITE(IOUT,FMT=6061)
IF (ONLINE) WRITE(ITOUT,FMT=6061)
6061 FORMAT(1X,'Still cannot find enough reflections ')
C
C---- otherwise expand central limit if possible
C
IF (LIMIT.LT.XMAX) THEN
LIMIT = LIMIT + 500
IF (VEE) VLIMIT = VLIMIT + 500
XLIMIT = LIMIT
VXLIMIT = VLIMIT
WRITE(IOUT,FMT=6063) NREF,NREFT,3*MINREF,2*LIMIT/100
IF (ONLINE) WRITE(ITOUT,FMT=6063) NREF, NREFT,3*MINREF,
+ 2*LIMIT/100
GOTO 20
ELSE
C
C---- Cannot expand limit any further, give up (drops down to 6020 below)
C
END IF
END IF
SPTMIN = PTMIN
PTMIN = PTMIN - 0.1
IF (PTMIN.LT.0.01) PTMIN = 0.01
WRITE(IOUT,FMT=6062) SPTMIN,PTMIN
IF (ONLINE) WRITE(ITOUT,FMT=6062) SPTMIN,PTMIN
6062 FORMAT(/,1X,'**** WARNING ****',/,1X,'Still too few ',
+ 'reflections, changing minimum fraction recorded',/,1X,
+ 'for partials from',F5.2,' to',F5.2)
GOTO 20
END IF
END IF
NWRN = NWRN + 1
WRITE (IOUT,FMT=6020) MINREF
6020 FORMAT(///1X,'****** FATAL ERROR *******',/1X,'There are no FUL',
+ 'LY recorded spots in central area of image',/1X,'If this ',
+ 'is really true, either include partials in the refinement',
+ /,1X,'by adding keywords: REFINEMENT INCLUDE PARTIALS',/,1X,
+ 'or if the cell is small, change the size of this area using',
+ ' the REFINEMENT LIMIT x keywords')
IF (ONLINE) WRITE (ITOUT,FMT=6020)
CALL SHUTDOWN
END IF
C
C **********************
CALL SORTUP3(NREF,X,Y,IRECNO)
C **********************
C
HWX = NXS/2
HWY = NYS/2
NXY = NXS*NYS
C
MAXW = (NXY+1)/2
IF (IMGP) MAXW = NXY
MAXB = 2*MAXW
IF (IMGP) MAXB = MAXW
MAXN = 0.5*MAXBUFF/MAXW
IF (MAXN.GT.100) MAXN = 100
C
NRSOLD = NRS
210 IF (.NOT.DOPROFILE) NRS = 0
C
C---- Counters for number of reflections rejected as overloaded,
C too close, too weak
C
NOVER = 0
NCLOSE = 0
NWEAK = 0
SUMBKG = 0.0
NSUM = 0
IF (VEE .AND. DOPROFILE) NRS = NRSOLD
IHALF = (60+NRS)/2 + 2
C
C---- Modify IHALF to allow for case of offset detector, where direct beam
C position may be actually at edge of detector !
C
IF ((XCEN+LIMIT)*FACT.GT.NREC) THEN
IHALF = 30 + REAL((XCEN+LIMIT)*FACT-NREC)/REAL(LIMIT*FACT)*30
IF (DEBUG(6)) THEN
WRITE(IOUT,FMT=6019) IHALF,NINT((XCEN+LIMIT)*FACT)
IF (ONLINE) WRITE(ITOUT,FMT=6019)IHALF,NINT((XCEN+LIMIT)*FACT)
6019 FORMAT(1X,'IHALF changed to',I5,' EDGE OF AREA AT RECORD',I3)
END IF
END IF
C
C
DO 220 I = 1,NREF
IWX(I) = NXS
220 CONTINUE
C
C
INDF = 1
INDL = 1
IFRST = 1
ILAST = 0
FULL = .FALSE.
230 CONTINUE
C
C---- Get the start of the raster for the first spot or
C for a spot after a gap
C
IBLK = X(INDF) - HWX
C
C--- Test this is inside the scanned area (essential for offset detector,
C the spot centre may lie on the detector but edge of measurement box
C may not.
IF ((IBLK.LT.XSCMIN).OR.(IBLK.GT.XSCMAX)) THEN
WRITE(IOUT,FMT=6021) IBLK,INDF,X(INDF),HWX
IF (ONLINE) WRITE(ITOUT,FMT=6021) IBLK,INDF,X(INDF),HWX
6021 FORMAT(//1X,'** FATAL ERROR **',/,1X,'When finding reflections ',
+ 'for refinement (CENTRE)',/,1X,'part of the measurement ',
+ 'box lies outside the scanned region of the image',/,
+ 1X,'(trying to read record',I10,')',/,1X,'Restrict the ',
+ 'size of the search area for spots using the:',/,1X,
+ 'REFINEMENT LIMIT x',/,1X,
+ 'keywords which will set the search box size to "x" mm',
+ ' on either side',/,1X,'of the direct beam')
CALL SHUTDOWN
END IF
C
C---- Test if sorted spot has to be included in
C this scan
C
C ****************
240 CALL RDBLK(IBLK)
C ****************
C
250 IF (INDL.EQ.NREF) GO TO 260
IF (FULL) GO TO 260
IF (IBLK.LT.X(INDL+1)-HWX) GO TO 260
INDL = INDL + 1
IF (INDL-INDF.EQ.MAXN-1) FULL = .TRUE.
GO TO 250
C
C---- Get results from this scan and start the next one
C
260 IBLK = IBLK + 1
C
C--- Test this is inside the scanned area (essential for offset detector,
C the spot centre may lie on the detector but edge of measurement box
C may not.
C
IF ((IBLK.LT.XSCMIN).OR.(IBLK.GT.XSCMAX)) THEN
WRITE(IOUT,FMT=6021) IBLK
IF (ONLINE) WRITE(ITOUT,FMT=6021) IBLK
CALL SHUTDOWN
END IF
C---- Store optical densities for all spots included in this scan
C the actual transfer of ods is done in the call to bswap
C
IF (INDL.LT.INDF) GO TO 290
C
C
DO 280 J = INDF,INDL
C
C---- MJ is pointer for reflection J, range 1 to MAXN
C
MJ = MOD(J-1,MAXN) + 1
IIY = Y(J)
KMN = IIY - HWY
KMX = IIY + HWY
IF ((KMN.LT.1).OR.(KMX.GT.IYLEN)) THEN
WRITE(IOUT,FMT=6023) KMN,KMX
IF (ONLINE) WRITE(ITOUT,FMT=6023) KMN,KMX
6023 FORMAT(//1X,'** FATAL ERROR **',/,1X,'When finding reflections ',
+ 'for refinement (CENTRE)',/,1X,'part of the measurement ',
+ 'box lies outside the scanned region of the image',/,
+ 1X,'(pixel limits in Y are',2I5,')',/,1X,'Restrict the ',
+ 'size of the search area for spots using the:',/,1X,
+ 'REFINEMENT LIMIT x',/,1X,
+ 'keywords which will set the search box size to "x" mm',
+ ' on either side',/,1X,'of the direct beam')
CALL SHUTDOWN
END IF
IF (J.NE.IFRST) GO TO 270
C
C---- If this reflection has just started,
C set byte pointer (PNTR) into BB.
C
C---- NJ is byte pointer to start address for reflection J (MJ)
C
C---- PNTR(J) gives current address in BB for relection J (MJ)
C
NJ = (MJ-1)*MAXB
PNTR(MJ) = NJ + 1
IFRST = IFRST + 1
270 IADDR = PNTR(MJ)
C
C ********************
CALL BSWAP(KMN,KMX,IADDR)
C ********************
C
C---- note IADDR is incremented in BSWAP
C
C---- Add in second part for summed partials
C
IF (ADDPART.AND.(IRECNO(J).LT.0)) THEN
C
C Reset IADDR (incremented in BSWAP)
IADDR = IADDR - (KMX - KMN + 1)
C *******************
CALL BSWAP2(KMN,KMX,IADDR)
C *******************
END IF
C
PNTR(MJ) = IADDR
IWX(J) = IWX(J) - 1
280 CONTINUE
290 CONTINUE
C
C---- Check if one or more spots are finished
C
IF (IWX(INDF).EQ.0) GO TO 300
C
IF (INDF.LE.INDL) GO TO 240
FULL = .FALSE.
GO TO 230
C
300 IND = ILAST*MAXW + 1
C
C Use measurement box if USEBOX is true
C
IF (USEBOX) THEN
C
C---- Extract degree of partiality for CGFIT
C
II = IRECNO(INDF)
IF (II.LT.0) II = -II
IPART = IMG(II)
IF (ADDPART) IPART = 0
C **************************************
CALL CGFIT(IARR(IND),IRAS,+1,DELX,DELY,SOD,SDELX,SDELY,IPART,
+ IFLAG)
C **************************************
IBACK = NINT(BACK)
ELSE
C **********************************************************
CALL CGFIND(IARR(IND),1,NXS,NYS,DELX,DELY,SOD,ODVAR,MINOD,NBKG,
+ IBACK,NPOVER,IFLAG)
C **********************************************************
END IF
C
C
IF (DEBUG(6)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6022) INDF,X(INDF),Y(INDF),NPOVER,
+ SOD,IRECNO(INDF),IPART,IFLAG
6022 FORMAT (1X,'INDF=',I4,' X,Y',2I6,' NPOVER=',I3,' SOD=',F10.1,
+ ' IRECNO',I5,' IPART',I4,' IFLAG',I3)
WRITE (IOUT,FMT=6022) INDF,X(INDF),Y(INDF),NPOVER,SOD,
+ IRECNO(INDF),IPART,IFLAG
C ********************************
IF (SPOT) CALL ODPLOT(IARR(IND),NXS,NYS,1)
C ********************************
END IF
C
C
C---- Reject reflections with too steep gradient
C (only tested with CGFIT).
IF (IFLAG.EQ.1) THEN
NBGBADG = NBGBADG + 1
GOTO 340
END IF
C---- Reject reflections with too many background points rejected
C (only tested with CGFIT)
IF (IFLAG.EQ.2) THEN
NBGBAD = NBGBAD + 1
GOTO 340
END IF
C
C---- Reject reflections containing zero value pixels (outside scanned
C area)
IF (IFLAG.EQ.3) THEN
NZPBAD = NZPBAD + 1
GOTO 340
END IF
C---- Reject overloaded spots (flagged with sod=-9999.)
C if calculating profile, check NPOVER explicitly as
C NPMAX may have been changed to find enough refinement spots
C
IF ((IFLAG.EQ.4).OR.(DOPROFILE.AND.(NPOVER.GT.NOVPIX))) THEN
NOVER = NOVER + 1
GO TO 340
END IF
C
C---- No tests needed if using reflection list from previous film
C
IF (GENLIST) GO TO 310
C
C---- Form sum for average background level
C
SUMBKG = SUMBKG + IBACK
NSUM = NSUM + 1
C
C---- Test on minimum intensity using sigma calculated from
C counting statistics (Selwyn granularity for film)
C the variance of the spot ods must be greater than
C NSIG*SIGMA on the first pass or 0.666*NSIG*SIGMA on the second,
C where SIGMA is calculated using the average od
C over the whole spot. NSIG defaults to 6, but can be changed
C by keyword NSIG
C When using CGFIT rather than CGFIND, ie using the mask to
C determine the c. of g., the selection test is that the average
C background subtracted pixel value for pixels in the peak must
C be gt NSIG times the sigma value for the background (calculated
C from counting statistics)
C **** Changed 5/3/97 to use I/sig(I) instead when using CGFIT, NSIG
C now initialised to 20.
C
IF (USEBOX) THEN
IF (SOD.LT.0.0) SOD = 0.0
CAL AVOD = SOD/NPEAK
CAL ODSIG = AVOD
CAL CALCSIG = SQRT(GAIN*BACK)
C
C---- Try using I/sig(I) instead
C
BGND = BACK*NPEAK
VARTOT = GAIN*(SOD+BGND+BGND*NPEAK/NBKG)
IF (VARTOT.LT.0) VARTOT = 0.0
CALCSIG = SQRT(VARTOT)
ODSIG = SOD
ELSE
ODSIG = SQRT(ODVAR)
AVOD = SOD/NXY
CALCVAR = (AVOD+MINOD)*GAIN
CALCSIG = SQRT(CALCVAR)
END IF
IF (DEBUG(6)) THEN
WRITE (IOUT,FMT=6024) X(INDF),Y(INDF),DELX,DELY,
+ AVOD,MINOD,IBACK,ODSIG,CALCSIG
6024 FORMAT (1X,'X=',I5,' Y=',I5,' DELX,DELY',2F5.1,' AVOD=',F6.1,' M',
+ 'INOD=',I4,' IBACK=',I4,' ODSIG=',F8.1,' CALCSIG=',F6.1)
IF (ONLINE) WRITE (ITOUT,FMT=6024) X(INDF),Y(INDF),DELX,DELY,
+ AVOD,MINOD,IBACK,ODSIG,CALCSIG
END IF
C
C
IF (ODSIG.LT.NSIG*CALCSIG) THEN
NWEAK = NWEAK + 1
GO TO 340
END IF
C
C
IF ((.NOT.VEE) .AND. DOPROFILE) GO TO 310
C
C---- Spots seperated by > 4 mm
C
IF (ABS(X(INDF)-LASTX).GT.ISEPN) LASTY = 0
C
C
IF (ABS(Y(INDF)-LASTY).LT.ISEPN) THEN
NCLOSE = NCLOSE + 1
GO TO 340
END IF
C
C---- Limit number of spots on lhs of film
C
IF (NRS.GT.IHALF .AND. X(INDF).LT.XCEN*FACT) GO TO 340
C
IF (NRS.EQ.MAXREF) GO TO 360
C
C
C---- Store ods for average spot profile
C
310 IF (DOPROFILE) THEN
C
C---- Exclude partials if possible
C
IF (EXPART.AND.((IRECNO(INDF).LT.0).AND.(.NOT.ADDPART)))
+ GOTO 340
C
NPROFL = NPROFL + 1
C
C Expand into an integer*2 array
C
CALL BEXPAN4(IARR(IND),IWORK,NXY)
C
DO 320 II = 1,NXY
IODPROF(II) = IWORK(II) + IODPROF(II)
320 CONTINUE
C
C
GO TO 340
END IF
C
C
NRS = NRS + 1
LASTX = X(INDF)
LASTY = Y(INDF)
XRS(NRS) = (X(INDF)+DELX)/FACT
YRS(NRS) = (Y(INDF)+DELY)/FACT
RRS(NRS) = IRECNO(INDF)
WXRS(NRS) = SDELX/FACT
WYRS(NRS) = SDELY/FACT
IF (DEBUG(6)) THEN
WRITE(IOUT,6025) NRS,XRS(NRS),YRS(NRS),SDELX/FACT,SDELY/FACT
IF (ONLINE) WRITE(ITOUT,6025) NRS,XRS(NRS),YRS(NRS),
+ SDELX/FACT,SDELY/FACT
6025 FORMAT(1X,'Stored as refinement reflection number',I5,' XRS',
+ F8.1,' YRS',F8.1,' SIGX,SIGY',2F7.2)
END IF
C
C
C
C---- Store indices if pattern matching
C
IF (MATCH) THEN
JREC = IRECNO(INDF)
IF (JREC.LT.0) JREC = -JREC
C
C
IHKLR(1,NRS) = IHG(JREC)
IHKLR(2,NRS) = IKG(JREC)
IHKLR(3,NRS) = ILG(JREC)
C
C
END IF
C
C
340 ILAST = ILAST + 1
IF (ILAST.EQ.MAXN) ILAST = 0
C
C---- Skip these tests for reflection list from previous film
C
IF (GENLIST) GO TO 350
C
C---- Test for films with high background (eg intense synchrotron
C films). If 25% of reflections have been measured, and
C lt (MINREF/4) refinement spots found, then change NSIG on basis of
C average background and start over again
C As this is essentially a dynamic range problem, it should not
C occur with image plates.
IF (INDF.EQ.NREF/4.AND.(NRS.LT.MINREF/4).AND.(.NOT.IMGP)) THEN
NN = INDF - NOVER
IF (NN.NE.0) AVBKG = SUMBKG/NN
C
C
IF (AVBKG.GT.140 .AND. NSIG.GT.4) THEN
NSIG = 4
WRITE (IOUT,FMT=6026) AVBKG,NSIG
6026 FORMAT (//1X,'****** WARNING *****',/1X,'Average background in c',
+ 'entral region is ',F5.1,/2X,'and therefore NSIG has bee',
+ 'n reduced to',I3,' to help find refinement spots')
IF (ONLINE) WRITE (ITOUT,FMT=6026) AVBKG,NSIG
GO TO 210
ELSE IF (AVBKG.GT.180 .AND. NSIG.GT.2) THEN
NSIG = 2
WRITE (IOUT,FMT=6026) AVBKG,NSIG
IF (ONLINE) WRITE (ITOUT,FMT=6026) AVBKG,NSIG
GO TO 210
END IF
END IF
C
C
350 INDF = INDF + 1
IF (INDF.LE.NREF) GO TO 290
360 CONTINUE
C
C---- All reflections found
C
IF (DOPROFILE) THEN
IF (NPROFL.GT.0) THEN
IF (EXPART) THEN
WRITE (IOUT,FMT=6028) NPROFL
IF (ONLINE) WRITE (ITOUT,FMT=6028) NPROFL
6028 FORMAT (/1X,I4,' Reflections included in AVERAGE SPOT PROFILE')
ELSE
WRITE (IOUT,FMT=6029) NPROFL,NPARTL
IF (ONLINE) WRITE (ITOUT,FMT=6029) NPROFL,NPARTL
6029 FORMAT (/1X,I4,' Reflections included in AVERAGE SPOT PROFILE',
+ ' including',I3,' partials')
END IF
ELSE
WRITE (IOUT,FMT=6030)
6030 FORMAT (//1X,'** NO reflections for AVERAGE SPOT PROFILE **')
IF (ONLINE) WRITE (ITOUT,FMT=6030)
END IF
RETURN
END IF
C
C
IF (NZPBAD.GT.0) THEN
WARN(14) = .TRUE.
WRITE (IOUT,FMT=6070) NZPBAD,NULLPIX
6070 FORMAT (//1X,I3
$ ,' reflections have been rejected because the '
$ ,' measurement box contains',/,1X
$ ,'pixels with values less or equal to',I5,
+ ' (assumed to '
$ ,'be outside the scanned area).',/,1X,
+ 'See warning at end of logfile or in summary file.')
IF (ONLINE) WRITE (ITOUT,FMT=6070) NZPBAD,NULLPIX
END IF
IF (NBGBAD.NE.0) THEN
WRITE (IOUT,FMT=6031) NBGBAD,BGFREJ
6031 FORMAT (//1X,I3,' reflections rejected because more than a ',
1 'fraction',F5.2,' of the background pixels were rejected')
IF (ONLINE) WRITE (ITOUT,FMT=6031) NBGBAD,BGFREJ
END IF
IF (NBGBADG.NE.0) THEN
WRITE (IOUT,FMT=6033) NBGBADG,GRADMAXR
6033 FORMAT (//1X,I3,' reflections rejected because the gradient',
1 '/background is greater then',F6.3)
IF (ONLINE) WRITE (ITOUT,FMT=6033) NBGBADG,GRADMAXR
END IF
IF (NRS.GE.MINREF) RETURN
C
C---- Problems... less than MINREF reflections found
C
NWRN = NWRN + 1
WRITE (IOUT,FMT=6032) NRS,NOVER,NWEAK,NSIG,NCLOSE
6032 FORMAT (/1X,'ONLY',I3,' Suitable reflections found',/1X,'There a',
+ 're',I5,' OVERLOADS',I5,' TOO WEAK (NSIG=',I3,') and',I5,
+ ' TOO CLOSE')
IF (ONLINE) WRITE (ITOUT,FMT=6032) NRS,NOVER,NWEAK,NSIG,NCLOSE
C
C---- See if reducing spot separation criterion helps
C
NPOSS = (NREF-NOVER-NWEAK)
IF (NCLOSE.GT.MINREF/5) THEN
SEP = 0.5*SEP
ISEPN = FACT*SEP*100.0
WRITE (IOUT,FMT=6034) SEP
6034 FORMAT (1X,'Spot separation test reduced to ',F3.1,' mm')
IF (ONLINE) WRITE (ITOUT,FMT=6034) SEP
C
C---- Ensure half of remaining reflections are on each side
C
IF (NPOSS.LT.60) THEN
IHALF = NPOSS/2 + 2
IF (VEE) IHALF = (NPOSS+NRS)/2 + 2
END IF
C
C
GO TO 210
C
C If this is because there are many overloads, allow up to
C five times the previous limit on the pixels in the peak which can be
C overloaded before rejecting the reflection.
C Note NPMAX is passed in common /OVRLD/ to CGFIND,CGFIT
C
ELSE IF (NOVER.GT.NREF/2 .AND. NPMAX.LT.NOVPIX*5) THEN
USEOVRLD = .TRUE.
NPMAX = NOVPIX*5
WRITE (IOUT,FMT=6036) NPMAX,CUTOFF
6036 FORMAT (1X,'TOO MANY OVERLOADS in Central box',/1X,'Allow up to',
+ I3,' Pixels with values greater than',I6,' before ',
+ 'flagging as',
+ ' overloaded',/2X,'These reflections will not be included',
+ ' in the AVERAGE SPOT PROFILE ')
IF (ONLINE) WRITE (ITOUT,FMT=6036) NPMAX,CUTOFF
GO TO 210
C
C---- Have not got 3*MINREF possible reflections.
C---- If this is because they are all overloads, expand central box,
C providing it is smaller than the detector size, but before doing this
C try including partials if this is not already being done
C
ELSE IF (NREF-NOVER.LT.3*MINREF) THEN
IF (.NOT.PARTLS) THEN
C
C---- Intensity rejection criterion too high, reduce it (but only down
C to NSIG=5)
C
IF (NSIG.GT.5) THEN
NSIG = NINT(0.666*NSIG)
WRITE (IOUT,FMT=6040) NSIG
IF (ONLINE) WRITE (ITOUT,FMT=6040) NSIG
GO TO 210
END IF
C
C---- If total number (fulls plus partials) > 3*MINREF, then include
C partials
C
IF (NREFT.GE.3*MINREF) THEN
WRITE(IOUT,FMT=6060) NREF,PTMIN,MINREF
IF (ONLINE) WRITE(ITOUT,FMT=6060) NREF,PTMIN,MINREF
PARTLS = .TRUE.
GOTO 20
ELSE
C
C---- otherwise expand central limit if possible
C
IF (LIMIT.LT.XMAX) THEN
LIMIT = LIMIT + 500
IF (VEE) VLIMIT = VLIMIT + 500
XLIMIT = LIMIT
VXLIMIT = VLIMIT
WRITE(IOUT,FMT=6063) NREF,NREFT,3*MINREF,2*LIMIT/100
IF (ONLINE) WRITE(ITOUT,FMT=6063) NREF, NREFT, 3*MINREF,
+ 2*LIMIT/100
GOTO 20
ELSE
C
C---- Cannot expand limit any further, include partials
C
WRITE(IOUT,FMT=6060) NREF,PTMIN,MINREF
IF (ONLINE) WRITE(ITOUT,FMT=6060) NREF,PTMIN,MINREF
PARTLS = .TRUE.
GOTO 20
END IF
END IF
ELSE
C
C---- IF not using ADDPART, try decreasing PTMIN (to a minimum of 0.01)
C
IF (.NOT.ADDPART) THEN
IF (PTMIN.EQ.0.01) GOTO 370
SPTMIN = PTMIN
PTMIN = MAX(0.01,PTMIN-0.1)
WRITE(IOUT,FMT=6062) SPTMIN,PTMIN
IF (ONLINE) WRITE(ITOUT,FMT=6062) SPTMIN,PTMIN
GOTO 20
END IF
END IF
370 IF (LIMIT.LT.XMAX) THEN
LIMIT = LIMIT + 500
IF (VEE) VLIMIT = VLIMIT + 500
XLIMIT = LIMIT
VXLIMIT = VLIMIT
WRITE (IOUT,FMT=6038) 3*MINREF,2*LIMIT/100
6038 FORMAT (1X,'Less than',I3,' NON-OVERLOADED Reflections in centra',
+ 'l box',/1X,'Expand central area to',I4,' mm square.')
IF (ONLINE) WRITE (ITOUT,FMT=6038) 3*MINREF,2*LIMIT/100
IF (GENLIST) GOTO 90
GO TO 20
ELSE
WRITE (IOUT,FMT=6039) 3*MINREF,MINREF
IF (ONLINE) WRITE (ITOUT,FMT=6039) 3*MINREF,MINREF
6039 FORMAT(1X,'Less than',I3,' NON-OVERLOADED Reflections on ',
+ 'entire detector !!',/,1X,'Possible courses of action:',
+ /,1X,'1) Include overloads in refinement:',/,1X,
+ 'REFINEMENT INCLUDE OVERLOADS',//,1X,'2) Include ',
+ 'partials in refinement:',/,1X,
+ 'REFINEMENT INCLUDE PARTIALS',//,1X,'3) Reduce the',
+ ' minimum acceptable number of reflections for ',
+ 'refinement',/,1X,'(Currently',I3,'):',/,1X,
+ 'REFINEMENT NREF 10 (say)')
CALL SHUTDOWN
END IF
ELSE
C
C---- Intensity rejection criterion too high, reduce it (but only down
C to NSIG=1)
C
IF (NSIG.EQ.1) RETURN
NSIG = NINT(0.666*NSIG)
WRITE (IOUT,FMT=6040) NSIG
6040 FORMAT (1X,'NSIG Reduced to',I3,' Repeating search')
IF (ONLINE) WRITE (ITOUT,FMT=6040) NSIG
GO TO 210
END IF
END
C
C== CGFIND ==
C
SUBROUTINE CGFIND(A,IDR,NX,NY,DELX,DELY,SOD,ODVAR,MINOD,NBKG,
+ IBACK,NPOVER,IFLAG)
C ===========================================================
C
IMPLICIT NONE
C
C---- Find centre of gravity of spots for centrs, when no
C background mask is defined.
C the background (IBACK) is determined by finding the
C mean density of the "NBKG" (the number of
C background points defined by the measurement box) pixels
C with the lowest density. this level is
C subtracted prior to finding the centre of gravity.
C ODVAR, the variance in the ods, is used as a criterion for
C selecting spots in centrs.
C IFLAG = 0 Spot is OK
C = 4 Overloaded spot
C
C---- 12/9/81 Change IA to I*4 from I*2, and calls to BEXPAN to BEXPAN4
C SORTUP to SORTUP4 to cope with dynamic range up to 64K
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL DELX,DELY,ODVAR,SOD
INTEGER IBACK,IDR,MINOD,NBKG,NPOVER,NX,NY,IFLAG
C ..
C .. Array Arguments ..
INTEGER*2 A(*)
C ..
C .. Local Scalars ..
REAL SOD2,SUMOD,SX,SY
INTEGER HX,HY,I,IBA,IJ,IOD,NXY,P,Q
C ..
C .. Local Arrays ..
INTEGER IS(MAXBOX)
INTEGER IA(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL BEXPAN4,SORTUP4
C ..
C .. Intrinsic Functions ..
INTRINSIC REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ovrld.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ovrld.h
C---- START of include file ovrld.h
C
C
C .. Scalars in Common Block /OVRLD/ ..
INTEGER NPMAX
C ..
C .. Common Block /OVRLD/ ..
COMMON /OVRLD/NPMAX
C ..
C
C
C&&*&& end_include ../inc/ovrld.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C ..
SAVE
C
IFLAG = 0
NXY = NX*NY
HX = NX/2
HY = NY/2
C
C Expand to integer*4 (for films,data is in bytes)
C ****************
CALL BEXPAN4(A,IA,NXY)
C ****************
C
C---- Find minimum and maximum od, and check for overloads and zero
C value pixels
C
NPOVER = 0
C
DO 20 I = 1,NXY
C
IOD = IA(I)
IF (IOD.GT.CUTOFF) NPOVER = NPOVER + 1
IF (NPOVER.GT.NPMAX) GO TO 70
IF (IOD.LE.NULLPIX) GOTO 80
20 CONTINUE
C
C Sort pixels into increasing order
CALL SORTUP4(NXY,IA,IS)
C
C---- Loop over bins to find mean background level
C
SUMOD = 0.0
MINOD = IA(IS(1))
C
C Don't use any spots which contains a zero pixel (must be in unscanned
C area of Hendrix image plate)
C
IF (MINOD.EQ.0) THEN
ODVAR = 0.0
SOD = 0.0
IBACK = 0
DELX = 0.0
DELY = 0.0
NPOVER = 0
RETURN
END IF
C
DO 30 I = 1,NBKG
SUMOD = IA(IS(I)) + SUMOD
30 CONTINUE
C
C---- Set background to mean of the NBKG points + 1 (to avoid zero's)
C
IBACK = SUMOD/NBKG + 1
C
SX = 0.0
SY = 0.0
SOD = 0.0
SOD2 = 0.0
IJ = 1
HX = HX*IDR
C
C
DO 60 P = -HX,HX,IDR
DO 50 Q = -HY,HY
IBA = IA(IJ) - IBACK
SX = P*IBA + SX
SY = Q*IBA + SY
SOD = SOD + IBA
SOD2 = REAL(IBA)*REAL(IBA) + SOD2
IJ = IJ + 1
50 CONTINUE
60 CONTINUE
C
C---- Calculate first moment
C
ODVAR = SOD2/NXY - (SOD/NXY)**2
C
IF (SOD.NE.0.0) THEN
DELX = SX/SOD
DELY = SY/SOD
END IF
RETURN
C
C
70 IFLAG = 4
SOD = 0.0
C
80 IFLAG = 3
SOD = 0.0
C
END
C== CGFIT ==
C
SUBROUTINE CGFIT(RAS,IRAS,IDR,DELX,DELY,SPOT,SDELX,SDELY,IPART,
+ IFLAG)
C ==============================================================
C
IMPLICIT NONE
C Determine the centre of gravity of the spot and its integrated
C intensity (SPOT)
C Introduce rejection of background pixels 11/3/91
C
C Returns:
C DELX, DELY c. og g. shift from centre of box
C SPOT Integrated intensity
C SDELX,SDELY Standard deviations in centre of gravity coords.
C IFLAG = 0 Spot is OK
C = 1 Too steep background gradient
C = 2 Too many background pixels rejected
C = 3 Contains zero value pixels
C = 4 Overloaded spot
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL DELX,DELY,SPOT,SDELX,SDELY
INTEGER IDR,IPART,IFLAG
C ..
C .. Array Arguments ..
INTEGER IRAS(5)
INTEGER*2 RAS(*)
C ..
C .. Local Scalars ..
REAL A,B,C,SOD,SPOD,SPP,SQOD,SQQ,TOD,TPOD,TPP,TQOD,TQQ,GRADM,
+ SP,SQ,SPQ,BGDEVMAX,RMSBG,XSPOT,XFAC,GRAD,ERR,XMULT
INTEGER HX,HY,IC,IJ,IOD,IP,IPQ,IQ,IRX,IRY,NXY,NOVER,P,Q,S,T,NBKG,
+ NRMAX,NRFL,NXX,NYY,I,IODMAX,IODMIN,NPKSIZ,MODE
LOGICAL P1,P2,DEBG
C ..
C .. Local Arrays ..
INTEGER IA(MAXBOX),MASK(MAXBOX),MASKREJ(NREJMAX)
REAL PQSUMS(6),PQSUMINV(9)
C ..
C .. External Subroutines ..
EXTERNAL BEXPAN4,BGSOLVE,BGTEST
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ovrld.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ovrld.h
C---- START of include file ovrld.h
C
C
C .. Scalars in Common Block /OVRLD/ ..
INTEGER NPMAX
C ..
C .. Common Block /OVRLD/ ..
COMMON /OVRLD/NPMAX
C ..
C
C
C&&*&& end_include ../inc/ovrld.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(6),SPOD)
EQUIVALENCE (ASPOT(7),SQOD), (ASPOT(8),SOD), (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C), (ASPOT(12),BGDEVMAX)
C
C
SAVE
C .. Data statements ..
C
C
DATA DEBG/.FALSE./
C
C---- Mode for EVAL (signifies we have not flagged overlapped background
C pixels)
MODE = 0
NRFL = 1
IFLAG = 0
NXX = IRAS(1)
NYY = IRAS(2)
C IF (DEBG) CALL ODPLOT(RAS,NXX,NYY,1)
HX = IRAS(1)/2
HY = IRAS(2)/2
NXY = (2*HX+1)* (2*HY+1)
C
C *******************
CALL BEXPAN4(RAS,IA,NXY)
C *******************
C
IC = HX + HY - IRAS(3)
IRX = HX - IRAS(4)
IRY = HY - IRAS(5)
C
C---- Mean spot size (ie peak area of box) in X and Y
NPKSIZ = 0.25*(NXX + NYY - 2*(IRAS(4) + IRAS(5)))
C
SP = 0.0
SQ = 0.0
SPQ = 0.0
SPP = 0.0
SQQ = 0.0
SPOD = 0.0
SQOD = 0.0
SOD = 0.0
TPP = 0.0
TQQ = 0.0
TOD = 0.0
TPOD = 0.0
TQOD = 0.0
IODMAX = 0
IODMIN = 999999
C
C
S = 0
T = 0
IJ = 0
NOVER = 0
C
C
DO 10 I=1,6
PQSUMS(I) = 0.0
10 CONTINUE
C
DO 30 P = -HX,HX
IP = ABS(P)
P1 = (IP.GT.IRX)
P2 = (IP.EQ.IRX)
C
C
DO 20 Q = -HY,HY
IJ = IJ + 1
IQ = ABS(Q)
IOD = IA(IJ)
C
C---- Reject overloads
C
IF (IOD.GT.CUTOFF) NOVER = NOVER + 1
C
C---- Trap spots that include pixels outside scanned area
C
IF (IOD.LE.NULLPIX) GOTO 80
IF (IOD.GT.IODMAX) IODMAX = IOD
IF (IOD.LT.IODMIN) IODMIN = IOD
C
C
IF (NOVER.GT.NPMAX) THEN
GO TO 70
ELSE
IPQ = IP + IQ
C
C
IF (P1 .OR. IPQ.GT.IC .OR. IQ.GT.IRY) THEN
C
IF (IRAS(3).NE.0 .OR. IP.LT.IRX .OR. IQ.LT.IRY) THEN
C
C
IF (IRAS(3).GE.0 .OR. IPQ.LE.IC) THEN
C Background pixels
S = S + 1
SP = P + SP
SQ = Q + SQ
SPP = P*P + SPP
SQQ = Q*Q + SQQ
SPQ = P*Q + SPQ
SPOD = P*IOD + SPOD
SQOD = Q*IOD + SQOD
SOD = SOD + IOD
MASK(IJ) = -1
END IF
END IF
ELSE
C
C---- Treat pixles around Peak as OK now, as in integration 16/7/98
CAL ELSE IF (.NOT.P2 .AND. IPQ.NE.IC .AND. IQ.NE.IRY) THEN
C
C Peak pixels
T = T + 1
TPP = P*P + TPP
TQQ = Q*Q + TQQ
TPOD = P*IOD + TPOD
TQOD = Q*IOD + TQOD
TOD = TOD + IOD
MASK(IJ) = 1
END IF
END IF
20 CONTINUE
30 CONTINUE
C
C
C Background constants (no backgound points rejected)
A = SPOD/SPP
B = SQOD/SQQ
C = SOD/S
C
C Set up PQSUMS
PQSUMS(1) = SPP
PQSUMS(2) = SQQ
PQSUMS(3) = SPQ
PQSUMS(4) = SP
PQSUMS(5) = SQ
PQSUMS(6) = S
NBKG = S
C
C Set maximum allowed number of allowed background pixels to be
C rejected from background plane determination (as fraction of total)
C
NRMAX = NINT(BGFREJ*NBKG)
C
C ******************************************************
CALL EVAL(IA(1),MASK(1),IRAS,PQSUMS,BGSIG,NRMAX,NRFL,
+ MASKREJ,DEBG,MODE)
C ******************************************************
C
C---- Check that not too many background points have been rejected
C (Flagged by NRMAX=-999)
C
IF (NRMAX.EQ.-999) GOTO 90
C
C
C Check maximum gradient not exceeded
C
IF (C.GT.0.0) THEN
GRADM = MAX(ABS(A),ABS(B))/C
ELSE
GRADM = 0.0
END IF
IF (GRADM.GT.GRADMAXR) GOTO 100
C Recalculate SPOT based on new value of C
C
C
C
ASPOT(2) = T*C
SPOT = TOD - ASPOT(2)
C
C---- Catch zero spots
C
IF (SPOT.NE.0.0) THEN
DELX = (TPOD-A*TPP)/SPOT*IDR
DELY = (TQOD-B*TQQ)/SPOT
ELSE
DELX = 0.0
DELY = 0.0
END IF
C
C---- Calculate errors in c. of g.
C
C---- Calculate a crude gradient for this spot, used to boost sigma
C calculation, assuming a scanner error factor of 0.15
C
GRAD = (FLOAT(IODMAX-IODMIN))/NPKSIZ
ERR = (GRAD*0.15)**2
IF (MACHINE.EQ.'ADSC') ERR = (GRAD*0.20)**2
SDELX = 0.0
SDELY = 0.0
IJ = 0
IF (SPOT.EQ.0.0) GOTO 65
C
XSPOT = SPOT/GAIN
C
DO 50 P = -HX,HX
C
XFAC = (P-DELX)/XSPOT
XFAC = XFAC*XFAC
C
DO 40 Q = -HY,HY
IJ = IJ + 1
IOD = NINT(IA(IJ)/GAIN)
IOD = IOD + NINT(ERR)
IF (MASK(IJ).EQ.1) THEN
SDELX = SDELX + XFAC*IOD
SDELY = SDELY + ((Q-DELY)/XSPOT)**2*IOD
END IF
40 CONTINUE
50 CONTINUE
C
C---- Fudge factor 2.5 boosts sigma estimates to get mean weighted residual
C of about 1.0. The need for this presumably reflects the fact that the
C accuracy of the centre of gravity determination is not solely determined
C by counting statistics. Since the strongest reflections are used in
C refinement, it may be partially due to scanner errors in regions of
C high gradients, but this is not yet clear. Another possibility is
C that the interpolation from the spiral scan to the orthogonal scan
C introduces errors in Mar Research and Mac Science detectors.
C
SDELX = 2.5*SQRT(SDELX)
SDELY = 2.5*SQRT(SDELY)
C
C---- Preliminary tests with RaxisIV images suggest an even larger inflation
C is required (for 100 micron raster). However, si this just because
C the spots are so large that the sd's get unreasonably small ?
C
IF (((MODEL.EQ.'RAXISIV').OR.(MODEL.EQ.'RAXISV'))
$ .AND.(RAST.LT.0.15)) THEN
SDELX = 2.0*SDELX
SDELY = 2.0*SDELY
END IF
IF (MACHINE.EQ.'ADSC') THEN
SDELX = 2.0*SDELX
SDELY = 2.0*SDELY
END IF
C
C---- is this really necessary for Bruker images?
C
IF (MACHINE.EQ.'BRUK') THEN
SDELX = 2.0*SDELX
SDELY = 2.0*SDELY
END IF
C
C---- Inflate standard deviations for partially recorded reflections. There
C is no obvious way to do this, so the following is highly empirical
C and may need to be revised. IPART is zero for fully recorded reflections
C and lies between 1 and 99 for partials, 1 is least fully recorded, 100
C is again fully recorded.
C
IF (IPART.NE.0) THEN
IF (IPART.LE.25) THEN
XMULT = 7.0
ELSE IF (IPART.LE.50) THEN
XMULT = 5.0
ELSE IF (IPART.LE.75) THEN
XMULT = 4.0
ELSE IF (IPART.LE.90) THEN
XMULT = 2.0
ELSE
XMULT = 1.5
END IF
SDELX = XMULT*SDELX
SDELY = XMULT*SDELY
END IF
C
65 CONTINUE
C
C
RETURN
C
C Overloaded spots
C
70 IFLAG = 4
SPOT = 0.0
RETURN
C
C Spots with zero pixel values
C
80 IFLAG = 3
SPOT = 0.0
DELX = 0.0
DELY = 0.0
RETURN
C
C Spots with too many rejected background points
90 IFLAG = 2
SPOT = 0.0
DELX = 0.0
DELY = 0.0
RETURN
C
C Spots with too steep a gradient
100 IFLAG = 1
SPOT = 0.0
DELX = 0.0
DELY = 0.0
END
C== CHECKHKL ==
SUBROUTINE CHECKHKL(IHKLSTR,IPU,IPS,IFLAG)
C
C
IMPLICIT NONE
C
C
C---- Check indices, IFLAG=0 if indices are equal,
C =1 if unique reflection is next in
C sorted list, =2 if generated reflection is next.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER IPU,IPS,IFLAG
C
C ..
C .. Array Arguments ..
INTEGER*2 IHKLSTR(MCOLSTR,NREFSTR)
C ..
C .. Local Scalars ..
INTEGER I,IHKLU,IHKLS,IH,IK,IL
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
IH = IHKLSTR(1,IPU)
IK = IHKLSTR(2,IPU)
IL = IHKLSTR(3,IPU)
IHKLU = ((IH+256)*512+(IK+256))*512 + IL + 256
IH = IHKLSTR(1,IPS)
IK = IHKLSTR(2,IPS)
IL = IHKLSTR(3,IPS)
IHKLS = ((IH+256)*512+(IK+256))*512 + IL + 256
IF (IHKLU.EQ.IHKLS) IFLAG = 0
IF (IHKLU.LT.IHKLS) IFLAG = 1
IF (IHKLU.GT.IHKLS) IFLAG = 2
RETURN
END
C== CHECKMASK ==
SUBROUTINE CHECKMASK(MASK,LRAS,NPBOX,NBADPIX)
IMPLICIT NONE
C
C---- This subroutine checks for overlapping peak pixels closer to the
C neighbouring spot than this one using the list of separations from
C MASKIT
C
C MASK is passed in
C DEBUG(48) for this S/R
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NPBOX,NBADPIX
C ..
C .. Array Arguments ..
INTEGER MASK(MAXBOX),LRAS(5)
C ..
C .. Local Scalars ..
INTEGER I,J,K,NXX,NYY,NHX,NHY,IJ,IOFFSET,IDX,IDY,NRX,NRY,NSEP,
+ ISEPX,ISEPY,P,Q,NXY,NTOT,NWSUM
REAL R1SQ,R2SQ
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
CAL EXTERNAL GENSORT,GETSTRIP,GETYIND,GETBOX,PQINV,SETMASK,RASPLOT4
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
INTEGER IDXSTORE,IDYSTORE,NUMB,NSTORE
COMMON /SEPAR/ IDXSTORE(200,NMASKS),IDYSTORE(200,NMASKS),
+ NUMB(200,NMASKS),NSTORE(NMASKS)
NBADPIX = 0
NWSUM = 0
NTOT = 0
C
C---- How many separations
C
NSEP = NSTORE(NPBOX)
IF (NSEP.EQ.0) RETURN
NXX = LRAS(1)
NYY = LRAS(2)
NXY = NXX*NYY
NHX = NXX/2
NHY = NYY/2
NRX = LRAS(4)
NRY = LRAS(5)
ISEPX = NHX - NRX
ISEPY = NHY - NRY
IF (DEBUG(48)) THEN
WRITE(IOUT,FMT=6000) NSEP
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSEP
END IF
6000 FORMAT(1X,'CHECKMASK.. number of separations:',I3)
C
C---- Loop over all possible separations
C
DO 40 I = 1,NSEP
C
C---- Loop over all peak pixels and test if they are also peak pixels
C in the neighbouring spot, and if so, which spot are they closest
C to.
C
NBADPIX = 0
IDX = IDXSTORE(I,NPBOX)
IDY = IDYSTORE(I,NPBOX)
IJ = 0
IOFFSET = IDX*NYY + IDY
C
DO 24 P = -NHX,NHX
C
C---- Test for overlap
C
IF ((IDX - P).GT.ISEPX) THEN
IJ = IJ + NYY
GOTO 24
END IF
DO 22 Q = -NHY,NHY
IJ = IJ + 1
IF ((IDY.GE.0).AND.((IDY - Q).GT.ISEPY)) GOTO 22
IF ((IDY.LE.0).AND.((IDY - Q).LT.-ISEPY)) GOTO 22
C
C---- Test if this pixel in both this spot and neighbouring spot
C
IF ((MASK(IJ).EQ.1).AND.(MASK(IJ - IOFFSET).EQ.1)) THEN
R1SQ = P*P + Q*Q
R2SQ = (IDX-P)*(IDX-P) + (IDY-Q)*(IDY-Q)
IF (R1SQ.GT.R2SQ) NBADPIX = NBADPIX + 1
END IF
22 CONTINUE
24 CONTINUE
C
C---- Sums for mean number of bad (overlapped) pixels weighted by
C number of times this separation occurs
NWSUM = NWSUM + NBADPIX*NUMB(I,NPBOX)
NTOT = NTOT + NUMB(I,NPBOX)
IF (DEBUG(48)) THEN
WRITE(IOUT,FMT=6002) I,IDX,IDY,IOFFSET,NBADPIX
IF (ONLINE) WRITE(ITOUT,FMT=6002) I,IDX,IDY,IOFFSET,NBADPIX
6002 FORMAT(1X,'Separation ',I3,' idx=',I3,' idy=',I3,' ioffset',
+ '=',I5,' Number bad pixels',I5)
END IF
C
C---- End of loop over separations
C
40 CONTINUE
IF (NTOT.NE.0) NBADPIX = NWSUM/NTOT
RETURN
END
C
C== CHECKU ==
C
C
C
SUBROUTINE CHECKU(U)
C ====================
C
C---- Check that U is a pure rotation matrix
C
C
C
C
C .. Array Arguments ..
REAL U(3,3)
C ..
C .. Local Scalars ..
REAL DET
INTEGER I,II,J,JJ
C ..
C .. Local Arrays ..
REAL U_INV(3,3),U_TRANS(3,3)
C ..
C .. External Subroutines ..
EXTERNAL MINV33,TRANSP
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common Blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
SAVE
C
C
C *******************
CALL MINV33(U_INV,U,DET)
C *******************
C
C---- Check the determinant
C
IF (ABS(DET-1.000).GT.0.001) THEN
C
WRITE (ITOUT,FMT=6000) DET
WRITE (ITOUT,FMT=6002) ((U(II,JJ),JJ=1,3),II=1,3)
C
STOP
ELSE
C
C---- Check that the transpose of U is equal to its inverse
C
C *****************
CALL TRANSP(U_TRANS,U)
C *****************
C
DO 20 J = 1,3
DO 10 I = 1,3
IF (ABS(U_TRANS(I,J)-U_INV(I,J)).GT.0.001) GO TO 30
10 CONTINUE
20 CONTINUE
C
C
RETURN
30 WRITE (ITOUT,FMT=6004)
WRITE (ITOUT,FMT=6002) ((U(II,JJ),JJ=1,3),II=1,3)
STOP
END IF
C
C---- Format statements
C
6000 FORMAT (/' ** ERROR ** The determinant of U is ',F9.5,' A value ',
+ 'of 1.0 would correspond to a simple rotation.')
6002 FORMAT (/' The matrix U defining the standard setting is:',
+ /3 (20X,3F9.5,/))
6004 FORMAT (/' ** ERROR ** The matrix Umat is not a simple rotation ',
+ 'matrix')
C
C
END
SUBROUTINE CHKBOX(IXS,IYS,IXF,IYF,ISTAT)
C =========================================
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C
C .. Scalar Arguments ..
INTEGER IXS,IYS,IXF,IYF,ISTAT
C
C ..
C .. Local Scalars ..
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
C---- Check for vector extending beyond display area
C
IF (IXS.LT.1) THEN
IF (IXF.GT.1) THEN
IXS = 1
ELSE
ISTAT = 1
END IF
END IF
IF (IXF.GT.NXDPX) THEN
IF (IXS.LT.NXDPX) THEN
IXF = NXDPX
ELSE
ISTAT = 1
END IF
END IF
C
IF (IYS.LT.1) THEN
IF (IYF.GT.1) THEN
IYS = 1
ELSE
ISTAT = 1
END IF
END IF
IF (IYF.GT.NYDPX) THEN
IF (IYS.LT.NYDPX) THEN
IYF = NYDPX
ELSE
ISTAT = 1
END IF
END IF
RETURN
END
C== CHKRAS ==
SUBROUTINE CHKRAS(AVPROFILE,MAXR,FIRSTFILM,FILM)
C ================================================================
C
IMPLICIT NONE
C
C
C AVPROFILE True on entry to this subroutine, but set false UNLESS
C a new average spot profile is to be determined because
C the overall dimensions of the measurement box have
C changed, in which case CENTRS is called again (by MAIN)
C
C FIRSTFILM True if this is first image in a block. If raster parameters
C are to be optimised, this is done for the first image in
C each new block of images.
C
C FILM 1 for A film, 2,3 for B and C films in pack
C
C---- Calculates average spot profile from
C measurements made by centrs.
C displays profile and measurement box on
C tektronix and allows box parameters to
C be changed.
C Optimises the raster parameters (BESTMASK)
C The summed ods are passed in array IODPROF in /PRO2/
C
C
C
C
C Elements of PQVAL
C p,q are pixel coords wrt centre of box
C These sums are set up by a call to SETSUMS
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C Elements of PQSUMS
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY. Note that these sums are set up in INTEG and are
C updated for every spot based on rejected background pixels
C in BGTEST.
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM = 200)
C ..
C .. Scalar Arguments ..
INTEGER MAXR,FILM
LOGICAL AVPROFILE,FIRSTFILM
C ..
C .. Local Scalars ..
REAL BGND,DELX,DELY,ODSCALE,RMSBG,SCALE,SPOTW,TBGND,TPEAK,
+ RATIOX,RATIOY,PREJX,PREJY,RATIO,VSPOT,VBG,AX,CTOT,
+ BGSIGL,X
INTEGER I,ISW2,KXSHIFT,KYSHIFT,MAXOD,MINOD,NC,NRX,NRY,NSIZ,
+ NXS,NXY,NYS,NRFL,NREJ,IFLAG,NBGOLD,
+ NBGOLDX,NBGOLDY,ISDBSI,NSIZE,NBGEXTRA,NINC,MODE,IHX,IHY,
+ NRXMIN,NRYMIN,NCMIN,IMODE,NPBOX,NCPKMIN,MAXPIX,
+ ICUTX,ICUTY,IXM,IYM,LINELEN,NUMLIN
LOGICAL FULL,STOPX,STOPY,PASS2,TOOBIG,LDENSE
CHARACTER JUNK*1,LINE*80,LINE2*80,STR1*1
C ..
C .. Local Arrays ..
REAL PQVAL(6),PQSUMS(6)
INTEGER KRAS(5),MASK(MAXBOX),MASKREJ(NREJMAX),IRBIG(2),
+ IODBIG(MAXBOX)
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
c
C ..
C .. External Subroutines ..
EXTERNAL BELL,INTEG,NOYES,RASPLOT,SETMASK,SETSUMS,
+ BESTMASK,EXTRACT,PKRIM
C ..
C .. Intrinsic Functions ..
INTRINSIC MAX,MIN,MOD
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/pro2.f
C--- awk generated include file pro2.h
C---- START of include file pro2.h
C
C .. Scalars in Common /PRO2/ ..
REAL PRCENSUM
C
C .. Arrays in Common Block /PRO2/ ..
INTEGER IODPROF
C ..
C .. Common Block /PRO2/ ..
COMMON /PRO2/PRCENSUM,IODPROF(MAXBOX)
C ..
C
C
C&&*&& end_include ../inc/pro2.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (ASPOT(1),SPOTW), (ASPOT(2),BGND),
+ (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(4),DELX), (ASPOT(5),DELY)
C ..
SAVE
DATA PASS2/.FALSE./,TOOBIG/.FALSE./
C
NRFL = 1
CTOT = 0.0
NPBOX = 1
LDENSE = .FALSE.
C
IF (DEBUG(15).AND.SPOT) THEN
WRITE(IOUT,FMT=6032) NXS,NYS
IF (ONLINE) WRITE(ITOUT,FMT=6032) NXS,NYS
MAXPIX = 0
CALL ODPLOT4(IODPROF(1),NXS,NYS,1,MAXPIX)
6032 FORMAT(/1X,'In CHKRAS, summed counts for average spot profile',
+ ' box size',2I3,/)
END IF
C
C
C---- PASS2 is TRUE if the best rim and corner parameters have already
C been determined, but the overall box was too small to get a satisfactory
C ratio of background to peak pixels. Under these circumstances CENTRS is
C called again with a large box, and this box is used to determine the
C best box size.
C
IF (PASS2) GOTO 20
C
C
NXY = NXS*NYS
IF (NXY.LE.MAXBOX) GO TO 10
NWRN = NWRN + 1
IF (ONLINE) WRITE (ITOUT,FMT=6000) MAXBOX
WRITE (IOUT,FMT=6000) MAXBOX
GO TO 50
10 CONTINUE
NSIZ = (NXY+1)/2
C
C---- Find max od, scale raster sum
C
MAXOD = 0
MINOD = 100000000
C
C
DO 12 I = 1,NXY
MAXOD = MAX(MAXOD,IODPROF(I))
MINOD = MIN(MINOD,IODPROF(I))
12 CONTINUE
C
C
SCALE = 255.0/ (MAXOD-MINOD)
C
C
IF (DEBUG(15)) THEN
IF (ONLINE) WRITE (ITOUT,6030) MINOD, MAXOD, SCALE
WRITE (IOUT,6030) MINOD,MAXOD,SCALE
6030 FORMAT(/1X,' In CHKRAS, MINOD = ',I10,' MAXOD = ',I20,
+ ' SCALE = ',F12.6)
END IF
C
C
C---- Find average spot shape and plot
C
IF (BRIEF) WRITE (IBRIEF,FMT=6002)
IF (ONLINE) WRITE (ITOUT,FMT=6002)
WRITE (IOUT,FMT=6002)
C
C ************************
CALL SETMASK(MASK,IRAS)
CALL SETSUMS(MASK,IRAS,PQVAL)
C ************************
C
TPEAK = PQVAL(5)
TBGND = PQVAL(6)
FULL = .TRUE.
BGSIGL = BGSIG
C
C **********************************************
13 CALL INTEG(IODPROF,IRAS,MASK,PQVAL,1,FULL,
+ BGSIGL,MASKREJ,PQSUMS,NRFL)
C **********************************************
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
X = 2*BGSIGL
IF (BRIEF) WRITE(IBRIEF,6020) BGSIGL,NBGMIN,X
WRITE(IOUT,6020) BGSIG,NBGMIN,X
IF (ONLINE) WRITE(ITOUT,6020) BGSIGL,NBGMIN,X
6020 FORMAT(//1X,'With the current BGSIG factor of',F6.2,
+ ' there are fewer than ',I3,' background',/,1X,
+ 'pixels remaining ',
+ 'for this profile after rejecting outliers.',/,1X,
+ 'Increasing BGSIG to ',F6.2,' to allow determination ',
+ 'of average spot profile',/,1X,'and optimisation of',
+ ' measurement box',/,1X,'BGSIG will be reset to its ',
+ 'original value for integration.')
BGSIGL = X
IF (BGSIGL.GT.100) THEN
WRITE(IOUT,6021) BGSIGL
IF (ONLINE) WRITE(ITOUT,6021) BGSIGL
CALL SHUTDOWN
END IF
GOTO 13
END IF
C
C---- Get integrated intensity, sigma and I/sigma
C Need TBGND and TPEAK
NREJ = ASPOT(15)
C
C---- Must update number of background points to allow for rejected
C pixels.
C
TBGND = TBGND - NREJ
C
C---- Calculate standard deviation of intensity
C
VSPOT = GAIN*SPOTW
VBG = TPEAK*RMSBG*RMSBG
C
C
C---- This sigma does not include instrument error correction
C (added later) unless the scanner error factor has been set explicitly
C
C *** Change this to counting statistics based value
C ISDBSI = SQRT(2*VBG+ABS(VSPOT))*SCAI + 0.5
AX = GAIN*(SPOTW+BGND+BGND*TPEAK/TBGND)
ISDBSI=SQRT(AX) + 0.5
IF (.NOT.PROPTCEN) THEN
WRITE(IOUT,FMT=6100) TBGND,TPEAK,NREJ,SPOTW,BGND,ISDBSI,
+ SPOTW/FLOAT(ISDBSI)
IF (ONLINE) WRITE(ITOUT,FMT=6100) TBGND,TPEAK,NREJ,SPOTW,BGND,
+ ISDBSI,SPOTW/FLOAT(ISDBSI)
END IF
6100 FORMAT(1X,'No backgnd points',F5.0,' Number peak pixels',F5.0,
+ /,1X,'Number background rejected',I4,/,1X,'Intensity',
+ f10.0,' BACKGROUND',F12.0,' sigma',I6,' I/sig',F6.0)
C
IF (PROPTCEN.AND.FIRSTFILM.AND.(FILM.EQ.1)) THEN
C
C---- First optimise the rim and corner parameters using the supplied
C overall measurement box size. IRAS is updated by this call.
C IFLAG is returned negative if BESTMASK fails, but this is not yet
C coded.
C
C---- Set MASKREJ(1) to zero as this is now used by BESTMASK when setting
C up the masks
C
MASKREJ(1) = 0
MODE = 0
C
C---- First see if neighbouring spots intrude
C
IHX = NXS/2
IHY = NYS/2
IMODE = 0
CALL PKRIM(IODPROF,CTOT,IHX,IHY,IMODE,NRXMIN,NRYMIN,NCMIN)
C
C---- Now test that the values of NRXMIN, NRYMIN, NCMIN are sensible...
C if ther is a very large error in the orientation, so the peak is
C not in the centre of the box for the average spot profile,
C the number returned can be meaningless. Ensure the resulting peak
C is at least 5 pixels across.
C
IF (NRXMIN.GT.IHX-2) NRXMIN = IHX - 2
IF (NRYMIN.GT.IHY-2) NRYMIN = IHY - 2
AX = NXS**2 + NYS**2
NCPKMIN = NINT(0.5*SQRT(AX) - 3)
IF (NCMIN.GT.NCPKMIN) NCMIN = NCPKMIN
CALL BESTMASK(IODPROF,IRAS,NPBOX,MODE,PQSUMS,MASKREJ,BGSIGL,
+ IFLAG,CTOT,NRXMIN,NRYMIN,NCMIN,TOLMIN)
C
C---- Now optimise the overall size to get the desired ratio of background
C pixels to peak pixels (default 2)
IF (.NOT.FIXBOX) THEN
C
C---- First get number of peak/background for current box
C
C *****************************************
CALL SETMASK(MASK,IRAS)
CALL SETSUMS(MASK,IRAS,PQVAL)
15 CALL INTEG(IODPROF,IRAS,MASK,PQVAL,1,FULL,
+ BGSIGL,MASKREJ,PQSUMS,NRFL)
C ******************************************
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
X = 2*BGSIGL
IF (BRIEF) WRITE(IBRIEF,6020) BGSIG,NBGMIN,X
WRITE(IOUT,6020) BGSIG,NBGMIN,X
IF (ONLINE) WRITE(ITOUT,6020) BGSIG,NBGMIN,X
BGSIGL = X
IF (BGSIGL.GT.100) THEN
WRITE(IOUT,6021) BGSIGL
IF (ONLINE) WRITE(ITOUT,6021) BGSIGL
6021 FORMAT(/,/,1X,'***** FATAL ERROR *****',/,1X,
+ 'Value of ',F8.1,' for BGSIG is unreasonbable.')
CALL SHUTDOWN
END IF
GOTO 15
END IF
NBGOLD = NINT(PQSUMS(6))
RATIO = PQSUMS(6)/PQVAL(5)
IF (DEBUG(15)) THEN
NREJ = ASPOT(15)
WRITE(IOUT,FMT=6024) RATIO,BGPKRAT,PQSUMS(6),PQVAL(5),NREJ
IF (ONLINE) WRITE(ITOUT,FMT=6024) RATIO,BGPKRAT,PQSUMS(6),
+ PQVAL(5),NREJ
6024 FORMAT(1X,'Background/peak ratio actual, min',2F7.2,1X,
+ ' numbers',2F5.0,' NREJ',I5)
END IF
IF (RATIO.LT.BGPKRAT) THEN
C
C---- Need to determine how big a box will be needed to get desired ratio
C
NSIZE = MIN(NXS,NYS)
NBGEXTRA = BGPKRAT*PQVAL(5) - PQSUMS(6)
NINC = NBGEXTRA/(NSIZE*2)
C
C---- Actually expand the box to get at least 1.5 times as many extra
C background pixels as are required (to allow for rejection)
C Change this, merely add 1
C NINC = NINT(1.5*NINC) + 1
NINC = NINC + 1
IRAS(1) = IRAS(1) + 2*NINC
IRAS(2) = IRAS(2) + 2*NINC
14 NXY = IRAS(1)*IRAS(2)
IF (NXY.GT.MAXBOX) THEN
TOOBIG = .TRUE.
IRAS(1) = IRAS(1) - 2
IRAS(2) = IRAS(2) - 2
NINC = NINC - 1
GOTO 14
END IF
C
C---- Now check that box size does not exceed MAXDIM. If it does, try
C to increase the box size in the other direction, but check total size
C does not exceed MAXBOX
C
ICUTX = 0
ICUTY = 0
16 IF (IRAS(1).GT.MAXDIM) THEN
IRAS(1) = IRAS(1) - 2
IF (IRAS(2).LT.MAXDIM) THEN
IRAS(2) = IRAS(2) + 2
ICUTY = ICUTY - 1
NXY = IRAS(1)*IRAS(2)
IF (NXY.GT.MAXBOX) THEN
IRAS(2) = IRAS(2) - 2
ICUTY = ICUTY + 1
END IF
END IF
ICUTX = ICUTX + 1
GOTO 16
END IF
17 IF (IRAS(2).GT.MAXDIM) THEN
IRAS(2) = IRAS(2) - 2
IF (IRAS(1).LT.MAXDIM) THEN
IRAS(1) = IRAS(1) + 2
ICUTX = ICUTX - 1
NXY = IRAS(1)*IRAS(2)
IF (NXY.GT.MAXBOX) THEN
IRAS(1) = IRAS(1) - 2
ICUTX = ICUTX + 1
END IF
END IF
ICUTY = ICUTY + 1
GOTO 17
END IF
C
C---- Increase corner cutoff and rims so peak size remains the same
C
IF ((ICUTX.EQ.0).AND.(ICUTY.EQ.0)) THEN
DO 18 I = 3,5
IRAS(I) = IRAS(I) + NINC
18 CONTINUE
ELSE
IRAS(3) = IRAS(3) + NINC - ICUTX
IRAS(4) = IRAS(4) + NINC - ICUTX
IRAS(5) = IRAS(5) + NINC - ICUTY
END IF
C
PASS2 = .TRUE.
IF (DEBUG(15)) THEN
WRITE(IOUT,FMT=6025) NBGEXTRA,2*NINC,IRAS
IF (ONLINE) WRITE(ITOUT,FMT=6025) NBGEXTRA,2*NINC,IRAS
6025 FORMAT(1X,I5,' Extra background points required, box',
+ ' expanded by',I3,' pixels in X and Y',/,1X,
+ 'New raster parameters',5I5)
END IF
C
C---- Give warning if desired background:peak ratio could not be achieved
C because of limitations on the total box size.
C
IF (TOOBIG) THEN
WRITE(IOUT,FMT=6050) BGPKRAT,MAXBOX
IF (ONLINE) WRITE(ITOUT,FMT=6050) BGPKRAT,MAXBOX
6050 FORMAT(/,1X,' *** WARNING ***',/,1X,'Cannot achieve a ',
+ 'ratio of ',F4.0,' in the number of background',
+ ' to peak',/,1X,'pixels because',
+ ' the maximum boxsize (',I5,') is too small.',/,1X,
+ 'If you need this ratio, recompile the program after',
+ ' increasing PARAMETER MAXBOX',/,1X,'with a global edit')
TOOBIG = .FALSE.
END IF
RETURN
END IF
END IF
END IF
C
C---- Now go to display profile
C
GOTO 46
C
C---- Only come this route if the average spot profile has been recollected
C using an enlarged box (PASS2 true). Now find the best box size to
C give desired background to peak ratio.
C
20 PASS2 = .FALSE.
IRBIG(1) = NXS
IRBIG(2) = NYS
NXY = NXS*NYS
C
C---- Reset IRAS to original values
C
NXS = NXS - 2*NINC
NYS = NYS - 2*NINC
DO 22 I = 3,5
IRAS(I) = IRAS(I) - NINC
22 CONTINUE
C
C---- Transfer the enlarged box pixel values to IODBIG
C
DO 34 I = 1,NXY
IODBIG(I) = IODPROF(I)
34 CONTINUE
C
C---- Find which direction (X or Y) gives greatest number of additional
C background points (after allowing for rejections).
C First try X, reset NXX, X rim, corner cutoff
36 IRAS(1) = IRAS(1) + 2
IRAS(3) = IRAS(3) + 1
IRAS(4) = IRAS(4) + 1
C
C---- Must stop X expanding beyond maximum value
C
IF (IRAS(1).GT.IRBIG(1)) THEN
STOPX = .TRUE.
GOTO 37
END IF
C *****************************************
CALL SETMASK(MASK,IRAS)
CALL SETSUMS(MASK,IRAS,PQVAL)
CALL EXTRACT(IODBIG,IRBIG,IRAS,IODPROF)
CALL INTEG(IODPROF,IRAS,MASK,PQVAL,1,FULL,
+ BGSIG,MASKREJ,PQSUMS,NRFL)
C ******************************************
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
STOPX = .TRUE.
PREJX = 0.0
GOTO 37
END IF
C
C---- See what percentage of new background pixels were accepted
C
NBGOLDX = NINT(PQSUMS(6))
PREJX = (PQSUMS(6) - NBGOLD)/(2.0*NYS)
RATIOX = PQSUMS(6)/PQVAL(5)
STOPX = (PREJX.LT.FRACREJ)
C
IF (DEBUG(15)) THEN
NREJ = ASPOT(15)
WRITE(IOUT,FMT=6022) IRAS,PREJX,RATIOX,NBGOLD,NREJ,STOPX
IF (ONLINE) WRITE(ITOUT,FMT=6022) IRAS,PREJX,RATIOX,
+ NBGOLD,NREJ,STOPX
6022 FORMAT(1X,'Changing X, raster',5I4,' acceptance ratio, bk/pk',
+ 2F6.2,' NBGOLD',I5,' NREJ',I5,' STOPX:',L2)
END IF
C
C---- Now try Y, first reset NXX and X rim
C
37 IRAS(1) = IRAS(1) - 2
IRAS(4) = IRAS(4) - 1
C
C---- Increment NYY and Y rim
C
38 IRAS(2) = IRAS(2) + 2
IRAS(5) = IRAS(5) + 1
C
C---- Must stop Y expanding beyond maximum value
C
IF (IRAS(2).GT.IRBIG(2)) THEN
IF (.NOT.STOPX) THEN
IRAS(2) = IRAS(2) - 2
IRAS(5) = IRAS(5) - 1
END IF
STOPY = .TRUE.
GOTO 39
END IF
C *****************************************
CALL SETMASK(MASK,IRAS)
CALL SETSUMS(MASK,IRAS,PQVAL)
CALL EXTRACT(IODBIG,IRBIG,IRAS,IODPROF)
CALL INTEG(IODPROF,IRAS,MASK,PQVAL,1,FULL,
+ BGSIG,MASKREJ,PQSUMS,NRFL)
C ******************************************
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
STOPY = .TRUE.
PREJY = 0.0
GOTO 39
END IF
C
C---- See what percentage of new background pixels were accepted
C
NBGOLDY = NINT(PQSUMS(6))
PREJY = (PQSUMS(6) - NBGOLD)/(2.0*NXS)
RATIOY = PQSUMS(6)/PQVAL(5)
STOPY = (PREJY.LT.FRACREJ)
IF (DEBUG(15)) THEN
NREJ = ASPOT(15)
WRITE(IOUT,FMT=6026) IRAS,PREJY,RATIOY,NBGOLD,NREJ,STOPY
IF (ONLINE) WRITE(ITOUT,FMT=6026) IRAS,PREJY,RATIOY,
+ NBGOLD,NREJ,STOPY
6026 FORMAT(1X,'Changing Y, raster',5I4,' acceptance ratio, bk/pk',
+ 2F6.2,' NBGOLD',I5,' NREJ',I5,' STOPY:',L2)
END IF
C
C---- Give up if both fail FRACREJ limit. Need to reset Y parameters
C and NC
C
39 IF (STOPX.AND.STOPY) THEN
C
C---- Rather than giving up, want to decrease FRACREJ and try again
C but don't reduce it beyond 0.1
C
IRAS(2) = IRAS(2) -2
IRAS(3) = IRAS(3) -1
IRAS(5) = IRAS(5) -1
IF (FRACREJ.GT.0.1) THEN
FRACREJ = MAX(FRACREJ-0.1,0.100)
IF (DEBUG(15)) THEN
WRITE(IOUT,FMT=6027) FRACREJ,IRAS
IF (ONLINE) WRITE(ITOUT,FMT=6027) FRACREJ,IRAS
6027 FORMAT(1X,'Decrease FRACREJ to',F4.2,' IRAS',5I5)
END IF
GOTO 36
ELSE
GOTO 42
END IF
END IF
C
C---- IS X or Y better ?
C
IF (PREJX.GT.PREJY.AND.(.NOT.STOPX)) THEN
C
C--- X is better, set raster parameters to those used for exapnsion in X
C
IRAS(1) = IRAS(1) + 2
IRAS(2) = IRAS(2) - 2
IRAS(4) = IRAS(4) + 1
IRAS(5) = IRAS(5) - 1
NBGOLD = NBGOLDX
C
C---- Jump out if ratio now OK
C
IF (RATIOX.GT.BGPKRAT) GOTO 42
GOTO 36
ELSE
C
C---- Y is best, jump out if ratio now OK, or too many points have
C been rejected in Y
C
IF ((RATIOY.GT.BGPKRAT).OR.(STOPY)) GOTO 42
NBGOLD = NBGOLDY
C
C---- Go back and try X again, unless too many points rejected in X
IF (.NOT.STOPX) THEN
GOTO 36
ELSE
GOTO 38
END IF
END IF
C
C---- Call INTEG again so that the rejected background pixels in MASKREJ
C are those for selected raster parameters
C
C *****************************************
42 CALL SETMASK(MASK,IRAS)
CALL SETSUMS(MASK,IRAS,PQVAL)
CALL EXTRACT(IODBIG,IRBIG,IRAS,IODPROF)
CALL INTEG(IODPROF,IRAS,MASK,PQVAL,1,FULL,
+ BGSIG,MASKREJ,PQSUMS,NRFL)
C ******************************************
C
IF (DEBUG(15)) THEN
WRITE(IOUT,FMT=6040) IRAS,PQSUMS(6),MASKREJ(1)
IF (ONLINE) WRITE(ITOUT,FMT=6040) IRAS,PQSUMS(6),MASKREJ(1)
6040 FORMAT(1X,'Final raster parameters',5I4,/1X,'Number of ',
+ 'background points used',F5.0,' Number rejected',I4)
IF (SPOT) THEN
WRITE(IOUT,FMT=6042) NXS,NYS
IF (ONLINE) WRITE(ITOUT,FMT=6042) NXS,NYS
MAXPIX = 0
CALL ODPLOT4(IODPROF(1),NXS,NYS,1,MAXPIX)
6042 FORMAT(/1X,'In CHKRAS, summed counts for average spot profile',
+ ' box size',2I3,/)
END IF
END IF
C
C---- Test that it has not rejected an unacceptable number of
C background points, there must be NBGMIN points left (set by
C subkeyword MINB under keyword REJECTION. If too many rejected
C reflection is flagged with ASPOT(1)=-9999
C
IF (ASPOT(1).EQ.-9999.0) THEN
IF (BRIEF) WRITE(IBRIEF,6020) BGSIG,NBGMIN
WRITE(IOUT,6020) BGSIG,NBGMIN
IF (ONLINE) WRITE(ITOUT,6020) BGSIG,NBGMIN
CALL SHUTDOWN
END IF
C
C---- Need to rescale with new box. Find max od, scale raster sum
C
MAXOD = 0
MINOD = 100000000
C
C
DO 44 I = 1,NXY
MAXOD = MAX(MAXOD,IODPROF(I))
MINOD = MIN(MINOD,IODPROF(I))
44 CONTINUE
C
C
SCALE = 255.0/ (MAXOD-MINOD)
C
C
C---- Now display the final profile with the best mask parameters and box size
C
46 CONTINUE
C ************************
CALL SETMASK(MASK,IRAS)
CALL SETSUMS(MASK,IRAS,PQVAL)
C ************************
C
DO 48 I = 1,NXY
IODPROF(I) = (IODPROF(I)-MINOD)*SCALE + 0.5
48 CONTINUE
DELX = (DELX+IXSHIFT)/FACT
DELY = (DELY+IYSHIFT)/FACT
IF (PROPTCEN.AND.FIRSTFILM.AND.(FILM.EQ.1)) THEN
WRITE (IOUT,FMT=6003) IRAS,NINT(PQVAL(5)),NINT(PQSUMS(6))
IF (ONLINE) WRITE (ITOUT,FMT=6003) IRAS,NINT(PQVAL(5)),
+ NINT(PQSUMS(6))
IF (BRIEF) WRITE (IBRIEF,FMT=6003) IRAS,NINT(PQVAL(5)),
+ NINT(PQSUMS(6))
C
C---- Calculate spot size in X and Y in mm
C
XWARN(1,1) = RAST*(IRAS(1)-2*IRAS(4))
XWARN(2,1) = RAST*(IRAS(2)-2*IRAS(5))
C
C---- If a SEPARATION keyword was not given and the separation was
C therefore worked out from the median spot size, update the
C separation parameters using this spot size. In this case,
C do NOT add on the saftey factor of 2 pixels
C
IF (ISEP.NE.2) THEN
IXSEP = 100.0*XWARN(1,1)
IYSEP = 100.0*XWARN(2,1)
MINDTX = NINT(ABS(IXSEP*COSOM0 + IYSEP*SINOM0))
MINDTY = NINT(ABS(IYSEP*COSOM0 + IXSEP*SINOM0))
WRITE(IOUT,FMT=6007) 0.01*IXSEP,0.01*IYSEP
IF (ONLINE) WRITE(ITOUT,FMT=6007) 0.01*IXSEP,0.01*IYSEP
END IF
END IF
WRITE (IOUT,FMT=6004) 0.01*DELX,0.01*DELY,RMSBG*SCALE
IF (ONLINE)WRITE (ITOUT,FMT=6004) 0.01*DELX,0.01*DELY,RMSBG*SCALE
IF (BRIEF)WRITE (IBRIEF,FMT=6004) 0.01*DELX,0.01*DELY,RMSBG*SCALE
ODSCALE = 1.0
C
C ***************************************
CALL RASPLOT(IODPROF,NXS,NYS,MASK,MASKREJ,1,ODSCALE)
C ***************************************
C
IF (PROPTCEN.AND.FIRSTFILM.AND.(FILM.EQ.1)) THEN
WRITE(IOUT,FMT=6005)
IF (ONLINE) WRITE(ITOUT,FMT=6005)
6005 FORMAT(/,1X,'If the peak region is too large, supply two',
+ ' values on the PROFILE TOLERANCE keyword.',/,1X,'The ',
+ 'first value is used for the centre of the image, and',
+ ' the second for the',/,1X,'outermost profiles. See ',
+ 'the helpfile for details.')
END IF
C
IF (.NOT.ONLINE) THEN
AVPROFILE = .FALSE.
GO TO 999
END IF
C
C *********
IF (ONLINE.AND.LBELL) CALL BELL
C *********
C
IF (PROPTCEN) THEN
AVPROFILE = .FALSE.
GO TO 80
END IF
C
C---- If not optimising the profile, and running interactively, give the
C opportunity to manually change the measurement box parameters
C but ONLY for the first image in each block
C
IF (.NOT.FIRSTFILM) GOTO 80
C
IF (WINOPEN) THEN
IXM = 200
IYM = 200
LINELEN = 75
NUMLIN = 15
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
C---- Do you want to
C
52 LINE = ' '
WRITE(LINE,FMT=6060)
6060 FORMAT('Do you want to change the measurement box',
+ ' parameters (N):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
WRITE(LINE,FMT=6062) IRAS
6062 FORMAT('Current parameters are:',5I5)
CALL MXDWIO(LINE, 1)
WRITE(LINE,FMT=6064)
6064 FORMAT('Give new parameters:')
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
GOTO 54
ELSE IF (NTOK.EQ.5) THEN
CALL MKEYNM(2,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 52
NEWRAS = 1
IRAS(1) = NINT(VALUE(1))
IRAS(2) = NINT(VALUE(2))
IRAS(3) = NINT(VALUE(3))
IRAS(4) = NINT(VALUE(4))
IRAS(5) = NINT(VALUE(5))
ELSE
GOTO 52
END IF
C
C---- various tests on supplied parameters
C
IF (((MOD(NXS,2).NE.1) .OR. (NXS.GT.MAXDIM)) .OR.
+ ((MOD(NYS,2).NE.1) .OR. (NYS.GT.MAXDIM))) THEN
WRITE(LINE,6066) MAXDIM
6066 FORMAT('NXS, NYS (first two values) must be ODD and less',
+ ' than',I3)
CALL MXDWIO(LINE,1)
GOTO 52
END IF
IF (NC.LE.0) THEN
WRITE(LINE,6067)
6067 FORMAT('NC (third value) must be > 0')
CALL MXDWIO(LINE,1)
GOTO 52
END IF
DO 56 I = 1,5
IF (IRAS(I).LE.0) THEN
WRITE(LINE,6068)
6068 FORMAT('All values must be > zero')
CALL MXDWIO(LINE,1)
GOTO 52
END IF
56 CONTINUE
C
C---- Return to form new profile
C
CALL MXDCIO(1,0,0,0,0)
RETURN
END IF
54 CALL MXDCIO(1,0,0,0,0)
GOTO 80
END IF
C
C---- If window not open
C
IF (BRIEF) WRITE (IBRIEF,FMT=6006)
WRITE (ITOUT,FMT=6006)
READ (ITIN,FMT=6008,END=80) JUNK
C
C ****************
CALL NOYES(JUNK,ISW2)
C ****************
C ISW2 returned as 1 if Y or y, otherwise 0
C
IF (ISW2.EQ.0) THEN
AVPROFILE = .FALSE.
GO TO 80
END IF
50 WRITE (IOUT,FMT=6010)
C
C *********
IF (ONLINE.AND.LBELL) CALL BELL
C *********
C
IF (BRIEF) WRITE (IBRIEF,FMT=6010)
WRITE (ITOUT,FMT=6010)
IF (BRIEF) WRITE (IBRIEF,FMT=6012) IRAS,IXSHIFT,IYSHIFT
WRITE (ITOUT,FMT=6012) IRAS,IXSHIFT,IYSHIFT
WRITE (IOUT,FMT=6012) IRAS,IXSHIFT,IYSHIFT
READ (ITIN,FMT=6014) KRAS,KXSHIFT,KYSHIFT
WRITE (IOUT,FMT=6015) KRAS,KXSHIFT,KYSHIFT
6015 FORMAT(1X,7I5)
C
C
DO 70 I = 1,5
IF (KRAS(I).EQ.0) GO TO 60
NEWRAS = 1
C
C---- A value of 99 is interpreted as zero
C
IF (KRAS(I).EQ.99) THEN
IRAS(I) = 0
ELSE
IRAS(I) = KRAS(I)
END IF
C
C
60 CONTINUE
70 CONTINUE
C
IF (KXSHIFT.NE.0) IXSHIFT = KXSHIFT
IF (KXSHIFT.EQ.99) IXSHIFT = 0
IF (KYSHIFT.NE.0) IYSHIFT = KYSHIFT
IF (KYSHIFT.EQ.99) IYSHIFT = 0
C
IF (((MOD(NXS,2).NE.1) .OR. (NXS.GT.MAXDIM))
+ .OR.((MOD(NYS,2).NE.1) .OR. (NYS.GT.MAXDIM))) THEN
WRITE (ITOUT,FMT=6016) MAXDIM
IF (BRIEF) WRITE (IBRIEF,FMT=6016) MAXDIM
GO TO 50
END IF
RETURN
C
80 CONTINUE
C
C---- Update maxr for precession photographs (done in s/r rmaxr for
C oscillation films)
C
IF (FIRSTFILM) MAXR = NXS*NYS
C
C
999 AVPROFILE = .FALSE.
C
C---- Reset profile to original values but subtract background, then set
C to zero at all background points, as this average
C profile is used to provide the weights when deriving best standard
C profiles over the whole detector in S/R PROCESS
NXY = NXS*NYS
PRCENSUM = 0.0
DO 92 I = 1,NXY
IF (MASK(I).LT.0) THEN
IODPROF(I) = 0
ELSE
IODPROF(I) = REAL(IODPROF(I))/SCALE + MINOD - ASPOT(11) + 0.5
IF (MASK(I).GT.0) PRCENSUM = PRCENSUM + IODPROF(I)
END IF
92 CONTINUE
IF (DEBUG(15).AND.SPOT) THEN
WRITE(IOUT,FMT=6028)
IF (ONLINE) WRITE(ITOUT,FMT=6028)
MAXPIX = 0
CALL ODPLOT4(IODPROF(1),NXS,NYS,1,MAXPIX)
6028 FORMAT(/1X,' Background subtracted, background zeroed average',
+ ' spot profile for weighting',/)
END IF
C
C---- Format statements
C
6000 FORMAT (/' Measurement box dimensions too large to display avera',
+ 'ge spot profile',/1X,'NXS*NYS Must be less than or equal',
+ ' to ',I5)
6002 FORMAT (1X,'Average spot profile for central region.',/,1X,
+ 'Rejected background ',
+ 'pixels flagged by "*", true background by "-"')
6003 FORMAT (1X,'Final optimised raster parameters:',5I5,/,1X,
+ 'This gives',I4,' pixels in the peak and',I4,
+ ' in background after rejecting outliers.',/,1X,
+ 'Note that the number of background pixels rejected',
+ ' on any individual spot',/,1X,'may be much smaller ',
+ 'than the number rejected here.')
6004 FORMAT (1X,'C. of G. SHIFTS =',2F7.3,'mm Background residual='
+ ,F5.1,' (peak scaled to 255)')
6006 FORMAT (/' Do you want to change the measurement box ?(y/n)')
6007 FORMAT(/,1X,'Separation parameters updated to ',F6.2,'mm in X',
+ ' and',F6.2,'mm in Y')
6008 FORMAT (A1)
6010 FORMAT (' Raster parameters and box shift:-',/2X,'NXS NYS NC ',
+ ' NRX NRY XSH YSH (ENTER 99 TO GET 0)')
6012 FORMAT (1X,I4,6I5,' ? Give new values in I5 format')
6014 FORMAT (1X,I4,6I5)
6016 FORMAT (' ***NXS and NYS MUST be ODD Integers < or = to ',I3)
C
C
END
C== CLCALC ==
C
C
C
SUBROUTINE CLCALC(CELL,A)
C ========================
C
C
C
C---- Calculate cell (real or reciprocal) from metric tensor A
C Angles in degrees
C
C
C
C
C .. Array Arguments ..
REAL A(3,3),CELL(6)
C ..
C .. Local Scalars ..
INTEGER I
REAL DTOR,X
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT,ACOS
C ..
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
DO 10 I = 1,3
CELL(I) = SQRT(A(I,I))
10 CONTINUE
C
X = A(2,3)/ (CELL(2)*CELL(3))
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
CELL(4) = ACOS(X)/DTOR
X = A(1,3)/ (CELL(1)*CELL(3))
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
CELL(5) = ACOS(X)/DTOR
X = A(1,2)/ (CELL(1)*CELL(2))
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
CELL(6) = ACOS(X)/DTOR
C
C
END
C== CLEAR ==
SUBROUTINE CLEAR(A)
C ==================
C
C .. Array Arguments ..
REAL A(9)
C ..
C .. Local Scalars ..
INTEGER I
C ..
C
C
DO 10 I = 1,9
A(I) = 0.0
10 CONTINUE
C
C
END
SUBROUTINE CNVPIX(IX,IY,ISTAT)
C =====================================
C
c Check that image pixel with coord IX,IY is within image.
c
c
c Output
c istat = 1 if outside display, else = 0 (OK)
c
IMPLICIT NONE
C
INTEGER IX,IY,ISTAT
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C check if in allowed display area
ISTAT = 0
IF (IX .LT. 1. OR. IX .GT. NXDPX .OR.
$ IY .LT. 1. OR. IY .GT. NYDPX) ISTAT = 1
RETURN
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== COMPLETE ==
SUBROUTINE COMPLETE(IHKLSTR,NTOTAL,IORDER)
C
IMPLICIT NONE
C
C LAST LABEL 470, FORMAT 6320
C Program to compile statistics on completeness of a data set
C
C The reflection list is stored in memory. For each unique reflection
C the following are stored:
C
C For each reflection: ADATA(6)
C 1-3 h,k,l
C 4 -999 (Identifier)
C 5 ICENT =0 centric
C =1 acentric
C 6 zero (not used)
C
C For generated reflections:
C ===========================
C H,K,L,BATCH,PHI,IC
C
C
C "BATCH" is 9999 for generated data (-999 for unique reflections)
C
C "PHI" is the phi value for the reflection. This is stored as an integer,
C and will be the truncated real phi (ie 4.8 will become 4)
C
C "IC" is modulo 2 of the number of the symmetry operation used
C to generate the correct indices, plus 1. Friedel pairs will
C therefore have values of 1 and 2. This is used to calculate the
C number of Friedel pairs.
C
C
C
C Originally coded by A.G.W. LESLIE NOV 1984
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM=200)
C IHKLSTR Array containing the reflections
C
C Need to use IHKLSTR(1,NTOTAL) onwards are working array
C ..
C .. Scalar Arguments ..
INTEGER NTOTAL
C
C ..
C .. Array Arguments ..
INTEGER*2 IHKLSTR(MCOLSTR,NREFSTR)
INTEGER IORDER(NTOTAL)
C ..
C .. Local Scalars ..
REAL PC,PC1,PHIFINI,PHIINCI,PHISTI,SN,SN2,STH,DTR,XSEP,YSEP,
+ SMAX,SMIN,RESMAX,RESMIN,SRESOL,STHINC,STHLMIN,STHLMAX,
+ DMAX,DMIN,DSTSQ,S,PHI1,PHI2,PHIINCR,CPHISTART,CPHIEND,
+ PHISEG,PHIFINAL,PHISTAUTO,X,PHITOT,PPHISTI,PPHIFINI,
+ AUTOINC,PHIADDAUTO,SUM1,SUM2
INTEGER I,IBATCH,IBIN,ICEN,IFLAG,IPHI,IPKF,IPKS,IREF,ISEG,J,K,
+ KPACK,MAXMLT,MULT,MULTPACK,N,N1,N2,NACROSS,NANO,
+ NANOMT,NBITS,NDIFFPACK,NEXTRA,NIN,NIN1,NIN2,
+ NMULT,NNPACK,NPACK,NPACK1,NPACK2,NPRINT,NRESO,NSEGIN,
+ NTOTPACK,NUNI,NUNIANOT,NLPRGI,IPRINT,NBIN,NBIT,
+ NTOK,IFSEG,IH,IK,IL,ITINS,JJ,ICOUNT,KK,ISTA,IFIN,IP,
+ IMODE,ICLEAR,IRUN,IRUNOLD,JRUN,IBINOLD,ICOMB,IROT,
+ NSEGSTART,ISTAFLG,IENDFLG,NDBG,ICENOLD,ISIZE,
+ IMAT,IUMAT,ICELL,ICHECK,MTZPRT,NCH
LOGICAL DUMPSPOT,EOF,MONITOR,COMREAD,STARTOK,ENDOK,RESET,LAST,
+ NEWRUN,DONETEST,INERR,NULINE
CHARACTER LINE*400,KEY*4,SUBKEY*4,HLPMOS*400,IOLINE2*1024
character xmlline*1024, xmlline2*1024, xmlline3*1024
C ..
C .. Local Arrays ..
REAL D(NRESBIN),PCENT(NRESBIN),PCENTANO(NRESBIN),CPHIFI(NSEGMAX),
+ CPHIFIN(MAXPAX),CPHIST(NSEGMAX),CPHIINC(NSEGMAX),
+ CPHISTA(MAXPAX),SPHIFI(NSEGMAX),CPHIADD(NSEGMAX),
+ SPHIINC(NSEGMAX),SPHIST(NSEGMAX),ADATA1(MCOLSTR),
+ ADATA2(MCOLSTR),KH(3),LH(3),VALUE(NPARM),PRSTA(MAXPAX),
+ PRFIN(MAXPAX),PHSBEST(NSEGMAX),PCUNIQA(MAXPAX),XMULT(MAXPAX)
INTEGER IPACK(MULTMAX),HKL1(3),HKL2(3),
+ IPFSEG(MAXPAX),IPKFI(NSEGMAX),
+ IPKST(NSEGMAX),IPSSEG(MAXPAX),ISPKFI(NSEGMAX),
+ ISPKST(NSEGMAX),JPACK(MAXDIFF+1,2),
+ LOOKUP(MCOLSTR),NANOM(NRESBIN),NISYM(MULTMAX),
+ NOBSRES(MAXPAX,NRESBIN),NTIMES(MAXPAX,MULTMAX),
+ NTOT(MAXPAX),NTOTRES(NRESBIN),NUNIANO(NRESBIN),
+ NUNIQA(MAXPAX),NUNIRES(NRESBIN),IBEG(NPARM),IDEC(NPARM),
+ IEND(NPARM),ITYP(NPARM),IFIRST(NSEGMAX),ICRUN(NSEGMAX)
INTEGER*2 JORDER(NSEGMAX),IPHIA(NSEGMAX)
C ..
C .. External Functions ..
INTEGER LENSTR
LOGICAL HKLEQ
EXTERNAL LENSTR,HKLEQ
C ..
C .. External Subroutines ..
EXTERNAL SORTUP2,MKEYNM,MPARSER,CCPUPC,MOSHLP,TESTOVER,SETMAT,
+ LWCLOS,WINDIO
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT,REAL,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
C ..
C .. Equivalences ..
EQUIVALENCE (KH(1),ADATA1(1)), (LH(1),ADATA2(1))
C ..
SAVE
DATA NUNIANOT/0/
C ..
C
IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6160) AUTO,NSTRUN,NSEGM,NSEGAUTO,CELLSCAL,SHRUNK
IF (ONLINE) WRITE(ITOUT,FMT=6160) AUTO,NSTRUN,NSEGM,NSEGAUTO,
+ CELLSCAL,SHRUNK
6160 FORMAT(//,1X,'Entering COMPLETE, AUTO',L2,', NSTRUN',I3,
+ ' NSEGM',I3,' NSEGAUTO',I3,' CELLSCAL',F7.4,
+ ' SHRUNK',L2)
END IF
RESET = .FALSE.
LAST = .FALSE.
NEWRUN = .FALSE.
IF (AUTO) NEWRUN = .TRUE.
DONETEST = .FALSE.
ITINS = ITIN
DTR = ATAN(1.0)/45.0
MONITOR = .TRUE.
COMREAD = .FALSE.
PHIINCR = 0.0
NULINE = .TRUE.
C
C---- Turn STATS off
C
IMODE = 0
C
DUMPSPOT = .FALSE.
NBIN = 8
NACROSS = 4
C
C---- Auto mode, generate the phi segments to be tested
C
IF (.NOT.AUTO) GOTO 2
C
C---- First, if there is more than one run, generate all segments for
C all runs up to the last one, and add up the total rotation angle
C
1 NSEGIN = 0
PHITOT = 0.0
IF (NSTRUN.GT.1) THEN
DO 390 JRUN = 1,NSTRUN-1
DO 380 I = 1,NSEGM
IRUN = NINT(PHIST(I))/360 + 1
IF (IRUN.EQ.JRUN) THEN
NSEGIN = NSEGIN + 1
IF (NSEGIN.GT.NSEGMAX) THEN
WRITE(IOUT,FMT=6004) NSEGMAX
IF (ONLINE) WRITE(ITOUT,FMT=6004) NSEGMAX
GOTO 20
END IF
CPHIST(NSEGIN) = PHIST(I)
CPHIFI(NSEGIN) = PHIFIN(I)
ICRUN(NSEGIN) = JRUN
C
C---- Only want one segment, set increment to entire phi range
C
CPHIINC(NSEGIN) = PHIFIN(I) - PHIST(I)
PHITOT = PHITOT + (PHIFIN(I)-PHIST(I))
IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6162) NSEGIN,JRUN,
+ CPHIST(NSEGIN),CPHIFI(NSEGIN),CPHIINC(NSEGIN)
IF (ONLINE) WRITE(ITOUT,FMT=6162) NSEGIN,JRUN,
+ CPHIST(NSEGIN),CPHIFI(NSEGIN),CPHIINC(NSEGIN)
6162 FORMAT(1X,'Set up segment',I3,' for run',I3,
+ ' start phi',F6.1,' end phi',F6.1,' increment',F5.1)
END IF
END IF
380 CONTINUE
390 CONTINUE
END IF
C
C---- NSEGIN.... Total number of segments, both from initial runs (if any)
C plus the number of segments in AUTO search
C NSEGSTART. Segment number for the first of the AUTO segments
C NSEGAUTO.. Number of AUTO segments
C
NSEGSTART = NSEGIN + 1
NSEGIN = NSEGIN + NSEGAUTO
ICOMB = 0
C
C---- If rotation angle for AUTO has not been assigned, set it to the
C angle required for complete data for this Laue group minus the
C total rotation angle of previous runs
C
IF (ROTAUTO.EQ.0) ROTAUTO = PHILAUE - PHITOT
C
C---- Set up the rotation angle for each AUTO segment
C Try initially to make them all equal
C
AUTOINC = 1.0
C
IF (SIZESET) GOTO 434
C
X = ROTAUTO/REAL(NSEGAUTO)
I = NINT(X/AUTOINC)
IF (ABS(I*AUTOINC-X).GT.0.1) THEN
C
C---- Cannot divide them up equally
C set first segment to nearest number of "steps"
C
PHISEGA(1) = I*AUTOINC
X = (ROTAUTO-PHISEGA(1))/REAL(NSEGAUTO-1)
I = NINT(X/AUTOINC)
IF (ABS(I*AUTOINC-X).GT.0.1) THEN
C
C---- Cannot divide remaining rotation equally, set the second segment
C
PHISEGA(2) = I*AUTOINC
X = (ROTAUTO-PHISEGA(1)-PHISEGA(2))/REAL(NSEGAUTO-2)
I = NINT(X/AUTOINC)
PHISEGA(3) = I*AUTOINC
PHISEGA(4) = (ROTAUTO - PHISEGA(1)-PHISEGA(2)-PHISEGA(3))
ELSE
DO 430 ISEG = 2,NSEGAUTO
PHISEGA(ISEG) = I*AUTOINC
430 CONTINUE
END IF
ELSE
DO 432 ISEG = 1,NSEGAUTO
PHISEGA(ISEG) = I*AUTOINC
432 CONTINUE
END IF
C
434 IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6150) NSEGAUTO,(PHISEGA(I),I=1,NSEGAUTO)
IF (ONLINE) WRITE(ITOUT,FMT=6150) NSEGAUTO,
+ (PHISEGA(I),I=1,NSEGAUTO)
6150 FORMAT(1X,'The segment widths for the',I2,' AUTO segments',
+ ' are:',/,1X,10F6.1)
END IF
C
C---- PHIFINAL is the end of the AUTO generated phi range
C
PHIFINAL = PHIFIN(NSEGM)
C
C---- PHISTAUTO is the start of the AUTO generated phi range
C
PHISTAUTO = PHIST(NSEGM)
PHIADDAUTO = PHIADD(NSEGM)
PCMAX = 0.0
C
400 CONTINUE
C
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
ICOMB = ICOMB + 1
IF (ICOMB.EQ.1) THEN
DO 402 ISEG = 1,NSEGAUTO
IF (ISEG.EQ.1) THEN
CPHIST(NSEGSTART) = PHISTAUTO
CPHIFI(NSEGSTART) = PHISTAUTO + PHISEGA(ISEG)
CPHIADD(NSEGSTART) = PHIADDAUTO
ICRUN(NSEGSTART) = NSTRUN
ELSE
CPHIST(NSEGSTART+ISEG-1) = CPHIFI(NSEGSTART+ISEG-2)
CPHIFI(NSEGSTART+ISEG-1) = CPHIST(NSEGSTART+ISEG-1) +
+ PHISEGA(ISEG)
CPHIADD(NSEGSTART+ISEG-1) = PHIADDAUTO
ICRUN(NSEGSTART+ISEG-1) = NSTRUN
END IF
402 CONTINUE
IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6164) ICOMB,NSEGSTART,NSEGIN,PHISTAUTO,
+ PHIFINAL,PHIADDAUTO,(CPHIST(I),I=NSEGSTART,NSEGIN)
IF (ONLINE) WRITE(ITOUT,FMT=6164) ICOMB,NSEGSTART,NSEGIN,
+ PHISTAUTO,PHIFINAL,PHIADDAUTO,(CPHIST(I),I=NSEGSTART,NSEGIN)
END IF
6164 FORMAT(//1X,'ICOMB',I3,' NSEGSTART',I3,' NSEGIN',I3,
+ ' PHISTAUTO',F7.1,' PHIFINAL',F7.1,' PHIADDAUTO',F7.1,
+ ' Phi start values',/,(1X,10F6.1))
ELSE
C
C---- Set up phi values for next combination of AUTO generated runs
C Increment the start angle of the LAST segment by PHIINC(NSEGM)
C (since the AUTO must always be the last segment to be input) and check
C that the end of the last segment is within the allowed phi
C range. If it goes beyond it, then increment the last but one
C auto segment and try again, and so on until all possible combinations
C have been tried.
C
DO 412 I = 1,NSEGAUTO
CPHIST(NSEGIN-I+1) = CPHIST(NSEGIN-I+1) + PHIINC(NSEGM)
CPHIFI(NSEGIN-I+1) = CPHIST(NSEGIN-I+1) +
+ PHISEGA(NSEGAUTO-I+1)
IF (I.EQ.1) GOTO 408
C
C---- If I>1, this is because incrementing just the last segment took
C phi beyond the allowed range. Now an earlier segment has been
C incremented, and all following segments must be reset to their
C starting positions. This is done below.
C
DO 406 J = NSEGIN-(I-2),NSEGIN
CPHIST(J) = CPHIST(J-1) + PHISEGA(J-NSEGSTART)
CPHIFI(J) = CPHIST(J) + PHISEGA(J-NSEGSTART+1)
406 CONTINUE
C
C---- See if end of last segment is within range
C
408 IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6164) ICOMB,NSEGSTART,NSEGIN,PHISTAUTO,
+ PHIFINAL,PHIADDAUTO,(CPHIST(J),J=NSEGSTART,NSEGIN)
IF (ONLINE) WRITE(ITOUT,FMT=6164) ICOMB,NSEGSTART,NSEGIN,
+ PHISTAUTO,PHIFINAL,PHIADDAUTO,(CPHIST(J),J=NSEGSTART,NSEGIN)
END IF
IF ((CPHIST(NSEGIN)+PHISEGA(NSEGAUTO)).LE.PHIFINAL) GOTO 414
412 CONTINUE
C
C---- No other possible segments
C
LAST = .TRUE.
IF (AUTANOM) THEN
c
c---- added so that we can have a TESTGEN line on the Strategy line
c
IF(TESTRAT)THEN
AUTO = .false.
testgen = .true.
phstart = PHSBEST(1)-360*ISTRUN-PHIADDAUTO
phend = PHSBEST(1)+PHISEGA(1)-360*ISTRUN-PHIADDAUTO
if(xover(1).lt.1e-1)xover(1) = 10.0
endif
c IF(SOCKLO)THEN
if(socklo .and. .not. testrat) then
c 6254 FORMAT('',
c $ ' ',
c $ ' ')
c 6255 FORMAT('',
c $ ' ',
c $ ' ')
c 6256 FORMAT('',
c $ ' ')
c trying this with some happy dna xml.
6254 format('',
$ 'ok',
$ '',
$ '', F4.1, '',
$ '',
$ '', F4.1, '')
6255 format('',
$ 'ok',
$ '',
$ '', F4.1, '',
$ '',
$ '', F4.1, '')
6256 format('',
$ F5.1, '',
$ F5.1, '')
c WRITE(xmlline3,FMT=6254)PCMAX,PHIINCI
c WRITE(xmlline2,FMT=6256)(I,PHSBEST(I)-360*ISTRUN-PHIADDAUTO,
c $ PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO,I=1
c $ ,NSEGAUTO)
c xmlline = xmlline3(1:lenstr(xmlline3)) //
c $ xmlline2(1:lenstr(xmlline2)) // ''
c CALL write_SOCKET_LENGTH(SERVERFD,lenstr(xmlline),xmlline)
xmlline3 = ' '
write(xmlline3, fmt = 6254) pcmax, phiinci
call write_socket_section(serverfd, lenstr(xmlline3),
$ xmlline3)
do i = 1, nsegauto
xmlline2 = ' '
write(xmlline2, fmt = 6256) phsbest(i) - 360 * istrun -
$ phiaddauto, phsbest(i) + phisega(i) - 360 * istrun
$ -phiaddauto
call write_socket_section(serverfd, lenstr(xmlline2),
$ xmlline2)
end do
xmlline3 = ''
call write_socket_length(serverfd, lenstr(xmlline3),
$ xmlline3)
ENDIF
WRITE(IOUT,FMT=6141) PCMAX,(PHSBEST(I)-360*ISTRUN-PHIADDAUTO,
+ PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO,I = 1,NSEGAUTO)
IF (ONLINE) WRITE(ITOUT,FMT=6141) PCMAX,(PHSBEST(I)-360*ISTRUN
+ -PHIADDAUTO,PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO,
+ I = 1,NSEGAUTO)
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6240) PCMAX
6240 FORMAT('Optimum rotation gives',F6.1,'% of anomalous',
+ ' pairs.')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6242)
6242 FORMAT('This corresponds to the following ',
+ 'rotation range(s) .')
CALL MXDWIO(LINE,1)
DO 440 I = 1,NSEGAUTO
LINE = ' '
WRITE(LINE,FMT=6244) PHSBEST(I)-360*ISTRUN-PHIADDAUTO,
+ PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO
6244 FORMAT('From ',F6.1,' to',F6.1,' degrees')
CALL MXDWIO(LINE,1)
440 CONTINUE
LINE = ' '
WRITE(LINE,FMT=6246)
6246 FORMAT('Type "STATS" at prompt for full statistics.')
CALL MXDWIO(LINE,3)
END IF
ELSE
c
c---- added so that we can have a TESTGEN line on the Strategy line
c
IF(TESTRAT)THEN
AUTO = .false.
testgen = .true.
phstart = PHSBEST(1)-360*ISTRUN-PHIADDAUTO
phend = PHSBEST(1)+PHISEGA(1)-360*ISTRUN-PHIADDAUTO
if(xover(1).lt.1e-1)xover(1) = 10.0
endif
WRITE(IOUT,FMT=6140) PCMAX,(PHSBEST(I)-360*ISTRUN-PHIADDAUTO,
+ PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO,I = 1,NSEGAUTO)
IF (ONLINE) WRITE(ITOUT,FMT=6140) PCMAX,(PHSBEST(I)-360*ISTRUN
+ -PHIADDAUTO,PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO,
+ I = 1,NSEGAUTO)
c IF(SOCKLO)THEN
if(socklo .and. .not. testrat) then
c WRITE(xmlline3,FMT=6255)PCMAX,PHIINCI
c print*, xmlline3
c WRITE(xmlline2,FMT=6256)(I,PHSBEST(I)-360*ISTRUN-PHIADDAUTO,
c $ PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO,I=1
c $ ,NSEGAUTO)
c xmlline = xmlline3(1:lenstr(xmlline3)) //
c $ xmlline2(1:lenstr(xmlline2)) // ''
c CALL write_SOCKET_LENGTH(SERVERFD,lenstr(xmlline),xmlline)
xmlline3 = ' '
write(xmlline3, fmt = 6255) pcmax, phiinci
call write_socket_section(serverfd, lenstr(xmlline3),
$ xmlline3)
do i = 1, nsegauto
xmlline2 = ' '
write(xmlline2, fmt = 6256) phsbest(i) - 360 * istrun -
$ phiaddauto, phsbest(i) + phisega(i) - 360 * istrun
$ -phiaddauto
call write_socket_section(serverfd, lenstr(xmlline2),
$ xmlline2)
end do
xmlline3 = ''
call write_socket_length(serverfd, lenstr(xmlline3),
$ xmlline3)
ENDIF
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6220) PCMAX
6220 FORMAT('Optimum rotation gives',F6.1,'% of unique',
+ ' data.')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6222)
6222 FORMAT('This corresponds to the following ',
+ 'rotation range(s):')
CALL MXDWIO(LINE,1)
DO 442 I = 1,NSEGAUTO
LINE = ' '
WRITE(LINE,FMT=6224) PHSBEST(I)-360*ISTRUN-PHIADDAUTO,
+ PHSBEST(I)+PHISEGA(I)-360*ISTRUN-PHIADDAUTO
6224 FORMAT('From ',F6.1,' to',F6.1,' degrees')
CALL MXDWIO(LINE,1)
442 CONTINUE
LINE = ' '
WRITE(LINE,FMT=6246)
CALL MXDWIO(LINE,3)
END IF
END IF
WRITE (IOUT,FMT=6143)
IF (ONLINE) WRITE (ITOUT,FMT=6143)
6140 FORMAT(//,1X,'Optimum rotation gives',F6.1,'% of unique',
+ ' data',/,1X,'This corresponds to the following ',
+ 'rotation range(s):',/,
+ (1X,'From ',F6.1,' to',F6.1,' degrees'))
6141 FORMAT(//,1X,'Optimum rotation gives',F6.1,'% of anomalous',
+ ' pairs',/,1X,'This corresponds to the following ',
+ 'rotation range(s):',/,
+ (1X,'From ',F6.1,' to',F6.1,' degrees'))
6143 FORMAT(1X,'Type "STATS" for full statistics.')
C
C---- Set up these angles to get full statistics if more than one
C run has been made
C
I = 0
DO 413 ISEG = NSEGSTART,NSEGIN
I = I + 1
CPHIST(ISEG) = PHSBEST(I)
CPHIFI(ISEG) = CPHIST(ISEG) + PHISEGA(I)
413 CONTINUE
IF (ICOMB.EQ.2) THEN
AUTO = .FALSE.
LAST = .FALSE.
WRITE(IOUT,FMT=6080)
IF (ONLINE) WRITE(ITOUT,FMT=6080)
WRITE(IOUT,FMT=6081)
IF (ONLINE) WRITE(ITOUT,FMT=6081)
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6081)
CALL WINDIO(NULINE)
END IF
GOTO 16
END IF
GOTO 414
END IF
C
C---- Set up
C
C
C---- Modify phi values to reflect run number
C
414 IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6170) (CPHIST(ISEG),CPHIFI(ISEG),
+ ISEG=1,NSEGIN)
IF (ONLINE) WRITE(ITOUT,FMT=6170) (CPHIST(ISEG),
+ CPHIFI(ISEG),ISEG=1,NSEGIN)
6170 FORMAT(1X,'Start and end values for the segments to be tested',
+ /,(1X,2F6.0))
END IF
DO 420 ISEG = NSEGSTART,NSEGIN
CAL IF (IRUN.EQ.0) IRUN = 1
CAL CPHIST(ISEG) = CPHIST(ISEG) + 360.0*(IRUN-1)
CAL CPHIFI(ISEG) = CPHIFI(ISEG) + 360.0*(IRUN-1)
C
C---- Find which of the original input segments this corresponds to
C
C---- Find which of the original input segments this corresponds to
C and check that it is a valid segment (ie one originally generated)
C
IFSEG = 0
DO 418 I = 1,NSEGM
IF ((CPHIST(ISEG).GE.PHIST(I)).AND.
+ (CPHIFI(ISEG).LE.PHIFIN(I)).AND.
+ (IFIRST(ISEG).EQ.IFIRSTONE(I))) THEN
IFSEG = I
END IF
418 CONTINUE
IF (IFSEG.EQ.0) THEN
WRITE(IOUT,FMT=6008)
IF (ONLINE) WRITE(ITOUT,FMT=6008)
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6260)
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6262)
CALL MXDWIO(LINE,1)
END IF
IF (AUTO) AUTO = .FALSE.
GOTO 16
END IF
CPHIINC(ISEG) = PHIINC(IFSEG)
CAL WRITE(6,*),'This is new,old segment,inc',ISEG,IFSEG,
CAL + CPHIINC(ISEG)
420 CONTINUE
C
C---- Initialise
C
2 NPACK = 0
IF (.NOT.AUTO) NSEGIN = 0
NUNIANOT = 0
NIN1 = 0
NUNI = 0
NRESO = 0
NEXTRA = 0
NIN = 0
NANOMT = 0
ICLEAR = 1
DO 4 I = 1,NRESBIN
NUNIRES(I) = 0
NUNIANO(I) = 0
NANOM(I) = 0
NTOTRES(I) = 0
4 CONTINUE
DO 10 I = 1,MAXPAX
NTOT(I) = 0
NUNIQA(I) = 0
DO 6 J = 1,NRESBIN
NOBSRES(I,J) = 0
6 CONTINUE
DO 8 J = 1,MULTMAX
NTIMES(I,J) = 0
8 CONTINUE
10 CONTINUE
DO 12 I = 1,MAXDIFF+1
JPACK(I,1) = 0
JPACK(I,2) = 0
12 CONTINUE
DO 14 I = 1,NSEGMAX
IFIRST(I) = 0
IPKST(I) = 0
IPKFI(I) = MAXPAX
14 CONTINUE
C
IF (AUTO) GOTO 20
C
IF (RESET) THEN
RESET = .FALSE.
GOTO 15
END IF
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
6000 FORMAT(//1X,'COMPLETE option',/,1X,'===============')
6001 FORMAT(1X,'Give the segments of data to be tested, in the form:',
+ /,1X,'START 0 END 20 (RUN 1)',/,1X,'(The RUN keyword is',
+ ' required if more than one run of the STRATEGY',/,1X,
+ 'option has been given)',/,1X,'Alternatively, RUN 1 will',
+ ' include all the data from the first run.',/,1X,
+ 'Give all the desired',
+ ' segments, then give RUN or GO keyword',/,1X,'To exit',
+ ' give keyword EXIT',/,1X,'To get full statistics',
+ ' after every run type STATS ON (cancel with STATS OFF)')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6280)
6280 FORMAT('Give the segments of data to be tested, in the form:')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6282)
6282 FORMAT('START 0 END 20 (RUN 1)')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6284)
6284 FORMAT('(The RUN keyword is',
+ ' required if more than one part has been generated)')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6286)
6286 FORMAT('Alternatively, RUN 1 will',
+ ' include all the data from the first run')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6288)
6288 FORMAT('Give all the desired',
+ ' segments, then give RUN or GO keyword')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6290)
6290 FORMAT('Type STATS ON to get full statistics (OFF to cancel)')
CALL MXDWIO(LINE,3)
END IF
16 IF (ONLINE) WRITE (ITOUT,FMT=6007)
6007 FORMAT (1X,'STRATEGY => ',$)
c
c---- to fool the program if this is a STRATEGY TESTGEN run
c
if(testrat)then
key='TEST'
ntok = 1
else
C
IF (WINOPEN) THEN
IF ((IOERR).OR.(INERR)) THEN
LINE = ' '
WRITE(LINE,FMT=6230)
6230 FORMAT('Error in input, please repeat.')
CALL MXDWIO(LINE,2)
END IF
LINE = ' '
WRITE(LINE,FMT=6232)
6232 FORMAT('STRATEGY => ')
CALL MXDWIO(LINE,0)
CALL MXDRIO(LINE)
NCH = LENSTR(LINE)
IF (NCH.GT.0) THEN
WRITE(IOUT,FMT=6234) LINE(1:NCH)
IF (ONLINE) WRITE(ITOUT,FMT=6234) LINE(1:NCH)
END IF
6234 FORMAT(1X,'STRATEGY => ',A)
C
C---- Decode this line.
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) GOTO 16
GOTO 450
END IF
C
C---- Read next keyword
C
C ******************************************************
CALL MPARSER(ITIN,IOUT,LINE,IBEG,IEND,ITYP,VALUE,
$ IDEC,NTOK)
C ******************************************************
endif
C
C---- eof ?
C
450 INERR = .FALSE.
IF (NTOK.EQ.-1) THEN
IF (COMREAD) THEN
COMREAD = .FALSE.
ITIN = ITINS
C CLOSE (UNIT=ICOMM)
END IF
WRITE(IOUT,FMT=6080)
IF (ONLINE) WRITE(ITOUT,FMT=6080)
STRATEGY = .FALSE.
NSTRUN = 0
NSEGM = 0
FIRSTRAT = .TRUE.
NSTRAT = 0
NLAST = 1
NNPACKS = 0
NLASTPACK = 1
ISTRUN = 0
IF (MTZOPEN) THEN
MTZPRT = 1
C *********************
CALL LWCLOS(MTZOUT,MTZPRT)
C *********************
MTZOPEN = .FALSE.
END IF
IF (SHRUNK) THEN
SHRUNK = .FALSE.
DO 38 I = 1,3
CELL(I) = CELL(I)*CELLSCAL
38 CONTINUE
IMAT = 1
IUMAT = 0
ICELL = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
WRITE(IOUT,FMT=6078) CELL
IF (ONLINE) WRITE(ITOUT,FMT=6078) CELL
END IF
RETURN
ELSE IF (NTOK.EQ.0) THEN
GOTO 16
END IF
C
IF (COMREAD) WRITE (ITOUT,FMT=6002) LINE(1:MIN(IEND(NTOK),120))
6002 FORMAT (1X,'STRATEGY => ',A)
C
C
C---- first 4 chars
C
KEY = LINE(IBEG(1) :IEND(1))
C
C---- convert to upper case
C
C ***********
CALL CCPUPC(KEY)
C ***********
C---- If statistics have been accumulated, and not printed, and this
C is not a request for statistics, reset arrays
C
IF ((ICLEAR.EQ.0).AND.(IMODE.NE.3).AND.KEY.NE.'STAT') THEN
RESET = .TRUE.
GOTO 2
END IF
15 IF (KEY.EQ.'STAR') THEN
INERR = .FALSE.
IF (IMODE.NE.3) IMODE = 0
NSEGIN = NSEGIN + 1
IF (NSEGIN.GT.NSEGMAX) THEN
WRITE(IOUT,FMT=6004) NSEGMAX
IF (ONLINE) WRITE(ITOUT,FMT=6004) NSEGMAX
6004 FORMAT(//,1X,'***** FATAL ERROR *****',/,1X,
+ 'Only',I5,' segments allowed in STRATEGY option')
GOTO 20
END IF
ISTA = 0
IFIN = 0
JRUN = 0
TESTGEN = .FALSE.
CPHIINC(NSEGIN) = 0.0
C
C---- Reset ETA in case it has been read in by MOSAIC keyword for
C a TESTGEN run
C
ETA = 0.00000001
ICOUNT = 2
C *******************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C *******************************************
IF (IOERR) INERR = .TRUE.
CPHIST(NSEGIN) = VALUE(ICOUNT)
ISTA = 1
18 ICOUNT = ICOUNT + 1
IF (ICOUNT.GT.NTOK) GOTO 460
SUBKEY = LINE(IBEG(ICOUNT):IEND(ICOUNT))
C **************
CALL CCPUPC(SUBKEY)
C **************
IF (SUBKEY.EQ.'END') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
CPHIFI(NSEGIN) = VALUE(ICOUNT)
IFIN = 1
ELSE IF (SUBKEY.EQ.'STEP') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
CPHIINC(NSEGIN) = ABS(VALUE(ICOUNT))
C
C---- RUN
C
ELSE IF ((SUBKEY.EQ.'RUN').OR.(SUBKEY.EQ.'PART')) THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
JRUN = 1
IRUN = ABS(VALUE(ICOUNT))
ICRUN(NSEGIN) = IRUN
C
C Not recognised
C
ELSE
INERR = .TRUE.
WRITE (IOUT,FMT=6006) SUBKEY
IF (ONLINE) WRITE (ITOUT,FMT=6006) SUBKEY
6006 FORMAT (//1X,'********** Sub-keyword NOT Recognised:',A)
END IF
IF (ICOUNT.LT.NTOK) GOTO 18
C
C--- Check both START and END given
C
460 IF (INERR) THEN
WRITE(IOUT,FMT=6118)
IF (ONLINE) WRITE(ITOUT,FMT=6118)
6118 FORMAT(1X,'*** Because there was an input error, the whole',
+ ' line has been ignored ***')
LINE = ' '
NSEGIN = NSEGIN -1
GOTO 16
END IF
IF ((ISTA.NE.1).OR.(IFIN.NE.1)) THEN
WRITE(IOUT,FMT=6003)
IF (ONLINE) WRITE(ITOUT,FMT=6003)
6003 FORMAT(1X,'***** ERROR *****',/,1X,
+ 'Must enter both START and END values')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6121)
6121 FORMAT('Must give both START and END, please repeat.')
CALL MXDWIO(LINE,2)
END IF
NSEGIN = NSEGIN - 1
GOTO 16
END IF
C
C---- Test RUN number given, if there only is one run then set up ICRUN
C else give warning
C
IF (JRUN.EQ.0) THEN
IF (NSTRUN.GT.1) THEN
WRITE(IOUT,FMT=6120)
IF (ONLINE) WRITE(ITOUT,FMT=6120)
6120 FORMAT(1X,'***** ERROR *****',/,1X,
+ 'Must specify the RUN number for this phi range')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6123)
6123 FORMAT('Must specify the RUN number for this phi range')
CALL MXDWIO(LINE,2)
END IF
NSEGIN = NSEGIN - 1
GOTO 16
ELSE
DO 17 I = 1,NSEGIN
ICRUN(I) = 1
17 CONTINUE
END IF
END IF
C
C---- Modify phi values to reflect run number
C
IF (IRUN.EQ.0) IRUN = 1
CPHIST(NSEGIN) = CPHIST(NSEGIN) + 360.0*(IRUN-1)
CPHIFI(NSEGIN) = CPHIFI(NSEGIN) + 360.0*(IRUN-1)
C
C---- Find which of the original input segments this corresponds to
C and check that it is a valid segment (ie one originally generated)
C
IFSEG = 0
DO 19 I = 1,NSEGM
IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6310) I,NSEGIN,CPHIST(NSEGIN),
+ CPHIFI(NSEGIN),PHIST(I),PHIFIN(I),PHIADD(I)
IF (ONLINE) WRITE(ITOUT,FMT=6310) I,NSEGIN,
+ CPHIST(NSEGIN),CPHIFI(NSEGIN),PHIST(I),
+ PHIFIN(I),PHIADD(I)
6310 FORMAT(1X, 'SEGMENT,NSEG',2I5,' CPHIST, CPHIFIN,',
+ 'PHIST,FIN,PHIADD',5F10.2)
END IF
IF ((CPHIST(NSEGIN).GE.PHIST(I)-PHIADD(I)).AND.
+ (CPHIFI(NSEGIN).LE.PHIFIN(I)-PHIADD(I)).AND.
+ (IFIRST(NSEGIN).EQ.IFIRSTONE(I))) THEN
IFSEG = I
CPHIST(NSEGIN) = CPHIST(NSEGIN) + PHIADD(I)
CPHIFI(NSEGIN) = CPHIFI(NSEGIN) + PHIADD(I)
CPHIADD(NSEGIN) = PHIADD(I)
END IF
19 CONTINUE
IF (IFSEG.EQ.0) THEN
WRITE(IOUT,FMT=6008)
IF (ONLINE) WRITE(ITOUT,FMT=6008)
6008 FORMAT(1X,'***** ERROR *****',/,1X,
+ 'Cannot match this rotation range with any of the ',
+ 'generated segments',/,1X,'This will happen if the ',
+ ' requested rotated range is greater than',/,1X,'that ',
+ 'generated by the original STRATEGY keywords',/,1X,
+ 'or if you have specified a phi range that was not',
+ ' generated by the',/,1X,'original STRATEGY keyword')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6260)
6260 FORMAT('*** ERROR in given phi range, try again ***')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6262)
6262 FORMAT('(See terminal window for more information)')
CALL MXDWIO(LINE,3)
END IF
NSEGIN = NSEGIN - 1
IF (AUTO) AUTO = .FALSE.
GOTO 16
END IF
C
C---- Default segment size (for analysis) to 5 degrees
C
IF (CPHIINC(NSEGIN).EQ.0) CPHIINC(NSEGIN) = 5.0
CAL WRITE(6,*),'This is new,old segment,inc',NSEGIN,IFSEG,
CAL + CPHIINC(NSEGIN)
C
C---- DEBUG
C
ELSE IF (KEY.EQ.'DEBU' ) THEN
IF (NTOK.EQ.1) THEN
DEBUG(56) = .TRUE.
DEBUG(57) = .TRUE.
ELSE
DEBUG(56) = .FALSE.
DEBUG(57) = .FALSE.
END IF
C
C
C---- MOSAIC
C
ELSE IF (KEY.EQ.'MOSA' ) THEN
C
C ************************************
CALL MKEYNM(1,2,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************
C
SETA = VALUE(2)
SETA = 0.5*DTR*SETA
C
C---- SEPAration x x
C
ELSE IF (KEY.EQ.'SEPA') THEN
C
C ************************************
CALL MKEYNM(2,2,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************
C
C---- Input in mms - stored as an integer in 10 microns units
C
IXSEP = NINT(VALUE(2)*100.0)
IYSEP = NINT(VALUE(3)*100.0)
C
C---- Convert spot separations (MINDTX,Y) into "ideal detector" coordinate
C frame, as the spot coordinates (generate file coords) are in this frame
C
XSEP = ABS(IXSEP*COSOM0 + IYSEP*SINOM0)
YSEP = ABS(IYSEP*COSOM0 + IXSEP*SINOM0)
MINDTX = NINT(XSEP)
MINDTY = NINT(YSEP)
C
C---- STATISTICS
C
ELSE IF (KEY.EQ.'STAT') THEN
IF (NTOK.EQ.2) THEN
SUBKEY = LINE(IBEG(2):IEND(2))
C **************
CALL CCPUPC(SUBKEY)
C **************
IF (SUBKEY.EQ.'ON') THEN
IMODE = 3
ELSE IF (SUBKEY.EQ.'OFF') THEN
IMODE = 0
ELSE
WRITE (IOUT,FMT=6006) SUBKEY
IF (ONLINE) WRITE (ITOUT,FMT=6006) SUBKEY
END IF
ELSE
IF (NUNI.NE.0) THEN
IMODE = 1
GOTO 280
ELSE
WRITE(IOUT,FMT=6100)
IF (ONLINE) WRITE(ITOUT,FMT=6100)
6100 FORMAT(1X,'No reflections have been predicted !!')
GOTO 16
END IF
END IF
C
C---- PART/RUN...Allow possibility of just giving PART/RUN number rather
C than START, END if all the run is to be included
C
ELSE IF (((KEY.EQ.'RUN').OR.(KEY.EQ.'PART'))
+ .AND.(NTOK.GE.2)) THEN
IF (IMODE.NE.3) IMODE = 0
ISTA = 0
IFIN = 0
ICOUNT = 2
C *******************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C *******************************************
IF (IOERR) THEN
WRITE(IOUT,FMT=6118)
IF (ONLINE) WRITE(ITOUT,FMT=6118)
GOTO 16
END IF
JRUN = NINT(VALUE(ICOUNT))
IF (JRUN.GT.NSTRUN) THEN
WRITE(IOUT,FMT=6130) JRUN,NSTRUN
IF (ONLINE) WRITE(ITOUT,FMT=6130) JRUN,NSTRUN
6130 FORMAT(1X,'*** ERROR *** You have asked for part',I3,
+ ' but there are only',I3,' parts')
GOTO 16
END IF
C
C---- Check for presence of STEP keyword
C
IF (NTOK.GT.2) THEN
ICOUNT = ICOUNT + 1
SUBKEY = LINE(IBEG(ICOUNT):IEND(ICOUNT))
C **************
CALL CCPUPC(SUBKEY)
C **************
IF (SUBKEY.EQ.'STEP') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) THEN
GOTO 16
END IF
PHIINCR = ABS(VALUE(ICOUNT))
C
C Not recognised
C
ELSE
INERR = .TRUE.
WRITE (IOUT,FMT=6006) SUBKEY
IF (ONLINE) WRITE (ITOUT,FMT=6006) SUBKEY
GOTO 16
END IF
END IF
C
C---- Find which of the currently stored segments belong to this run,
C using the fact that the phi values have multiples of 360 added for
C different runs
C
IF (PHIINCR.EQ.0) PHIINCR = 5.0
C
DO 30 I = 1,NSEGM
IRUN = NINT(PHIST(I))/360 + 1
IF (IRUN.EQ.JRUN) THEN
NSEGIN = NSEGIN + 1
IF (NSEGIN.GT.NSEGMAX) THEN
WRITE(IOUT,FMT=6004) NSEGMAX
IF (ONLINE) WRITE(ITOUT,FMT=6004) NSEGMAX
GOTO 20
END IF
CPHIST(NSEGIN) = PHIST(I)
CPHIFI(NSEGIN) = PHIFIN(I)
CPHIINC(NSEGIN) = PHIINC(I)
ICRUN(NSEGIN) = JRUN
END IF
30 CONTINUE
C
C---- AUTO
C
ELSE IF ((KEY(1:2).EQ.'AU').OR.(KEY(1:2).EQ.'RO')) THEN
C
C---- Turn OFF statistics
C
IMODE = 0
AUTO = .TRUE.
ICOUNT = 1
IROT = 0
ISEG = 0
ISIZE = 0
SIZESET = .FALSE.
IF (NTOK.EQ.1) GOTO 33
IF (KEY(1:2).EQ.'RO') THEN
SUBKEY = KEY
GOTO 470
END IF
32 ICOUNT = ICOUNT + 1
SUBKEY = LINE(IBEG(ICOUNT):IEND(ICOUNT))
C **************
CALL CCPUPC(SUBKEY)
C **************
C
C---- ROTATE (AUTO MODE)
C
470 IF (SUBKEY(1:2).EQ.'RO') THEN
C
IROT = 1
ICOUNT = ICOUNT + 1
C ************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************
IF (IOERR) INERR = .TRUE.
ROTAUTO = NINT(VALUE(ICOUNT))
C
C---- SEGMENTS (AUTO MODE)
C
ELSE IF (SUBKEY(1:2).EQ.'SE') THEN
C
ISEG = 1
ICOUNT = ICOUNT + 1
C ************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************
IF (IOERR) INERR = .TRUE.
NSEGAUTO = NINT(VALUE(ICOUNT))
C
C---- SIZES of SEGMENTS (AUTO MODE)
C
ELSE IF (SUBKEY(1:2).EQ.'SI') THEN
C
SIZESET = .TRUE.
31 ISIZE = ISIZE + 1
ICOUNT = ICOUNT + 1
C ************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************
IF (IOERR) INERR = .TRUE.
PHISEGA(ISIZE) = NINT(VALUE(ICOUNT))
IF (ICOUNT.LT.NTOK) THEN
IF (ITYP(ICOUNT+1).EQ.2) GOTO 31
END IF
C
C---- ANOM (Maximise anomalous pairs)
C
ELSE IF (SUBKEY(1:2).EQ.'AN') THEN
AUTANOM = .TRUE.
C
C---- Turn off anomalous optimisation
C
ELSE IF (SUBKEY.EQ.'NOTA') THEN
AUTANOM = .FALSE.
C
C Not recognised
C
ELSE
INERR = .TRUE.
WRITE (IOUT,FMT=6006) SUBKEY
IF (ONLINE) WRITE (ITOUT,FMT=6006) SUBKEY
END IF
IF (ICOUNT.LT.NTOK) GOTO 32
33 IF (INERR) THEN
WRITE(IOUT,FMT=6118)
IF (ONLINE) WRITE(ITOUT,FMT=6118)
AUTO = .FALSE.
GOTO 16
END IF
C
C
C---- Check that ROTATE subkeyword has been given
C
IF ((IROT.EQ.0).AND.(.NOT.SIZESET)) THEN
WRITE(IOUT,FMT=6082)
IF (ONLINE) WRITE(ITOUT,FMT=6082)
6082 FORMAT(1X,'*** ERROR ***',/,1X,'A ROTATION keyword must',
+ ' be given specifying the total phi',/,1X,
+ 'rotation to be used. eg ROTATION 50')
AUTO = .FALSE.
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6272)
6272 FORMAT('** ERROR ** a ROTATION subkeyword must be given')
CALL MXDWIO(LINE,1)
END IF
END IF
IF (ISEG.EQ.0) THEN
C
C---- Set number of segments to one by default
C
NSEGAUTO = 1
WRITE(IOUT,FMT=6084)
IF (ONLINE) WRITE(ITOUT,FMT=6084)
6084 FORMAT(1X,'No SEGMENT keyword given, assume 1 segment.')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6270)
6270 FORMAT('No SEGMENT keyword given, assume 1 segment.')
CALL MXDWIO(LINE,2)
END IF
END IF
IF ((IROT.EQ.0).AND.(.NOT.SIZESET)) GOTO 16
C
C---- Check that is SIZE has been given, then sizes are specified for ALL
C segments
C
IF ((ISIZE.GT.0).AND.(ISIZE.NE.NSEGAUTO)) THEN
WRITE(IOUT,FMT=6085) NSEGAUTO
IF (ONLINE) WRITE(ITOUT,FMT=6085) NSEGAUTO
6085 FORMAT(1X,'*** ERROR ***',/,1X,'If SIZEs of segments are',
+ ' given, they must be given for all',I3,' segments')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6274) NSEGAUTO
6274 FORMAT('** ERROR ** Must give SIZEs for all',I3,
+ ' segments.')
CALL MXDWIO(LINE,1)
INERR = .TRUE.
END IF
AUTO = .FALSE.
GOTO 16
END IF
C
ELSE IF (KEY.EQ.'TEST') THEN
C
C---- TESTGEN option
C
TESTGEN = .TRUE.
DONETEST = .TRUE.
ISTAFLG = 0
IENDFLG = 0
ICOUNT = 1
OSCANG = 0.0
IF (NTOK.EQ.1) GOTO 35
34 ICOUNT = ICOUNT + 1
SUBKEY = LINE(IBEG(ICOUNT):IEND(ICOUNT))
C **************
CALL CCPUPC(SUBKEY)
C **************
IF (SUBKEY(1:3).EQ.'STA') THEN
ICOUNT = ICOUNT + 1
C *******************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C *******************************************
IF (IOERR) INERR = .TRUE.
ISTAFLG = 1
PHSTART = VALUE(ICOUNT)
IF (ABS(PHSTART-NINT(PHSTART)).GT.0.01) THEN
WRITE(IOUT,FMT=6086) NINT(PHSTART)
IF (ONLINE) WRITE(ITOUT,FMT=6086) NINT(PHSTART)
6086 FORMAT(1X,'*** WARNING ***',/,1X,'Phi values and step must be',
+ ' integers, nearest integer',I5,' taken')
END IF
ELSE IF (SUBKEY.EQ.'END') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
IENDFLG = 1
PHEND = VALUE(ICOUNT)
IF (ABS(PHEND-NINT(PHEND)).GT.0.01) THEN
WRITE(IOUT,FMT=6086) NINT(PHEND)
IF (ONLINE) WRITE(ITOUT,FMT=6086) NINT(PHEND)
END IF
ELSE IF (SUBKEY.EQ.'STEP') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
PHSTEP = VALUE(ICOUNT)
IF (ABS(PHSTEP-NINT(PHSTEP)).GT.0.01) THEN
WRITE(IOUT,FMT=6086) NINT(PHSTEP)
IF (ONLINE) WRITE(ITOUT,FMT=6086) NINT(PHSTEP)
END IF
ELSE IF (SUBKEY(1:2).EQ.'AN') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
OSCANG = VALUE(ICOUNT)
ELSE IF (SUBKEY(1:3).EQ.'MIN') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
OSCMIN = VALUE(ICOUNT)
ELSE IF (SUBKEY(1:3).EQ.'MAX') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
OSCMAX = VALUE(ICOUNT)
ELSE IF (SUBKEY(1:2).EQ.'OV') THEN
ICOUNT = ICOUNT + 1
C
C ************************************************
CALL MKEYNM(1,ICOUNT,LINE,IBEG,IEND,ITYP,NTOK)
C ************************************************
IF (IOERR) INERR = .TRUE.
XOVER(1) = VALUE(ICOUNT)
C
C Not recognised
C
ELSE
INERR = .TRUE.
WRITE (IOUT,FMT=6006) SUBKEY
IF (ONLINE) WRITE (ITOUT,FMT=6006) SUBKEY
END IF
IF (ICOUNT.LT.NTOK) GOTO 34
C
C---- Test all values have been given
C
35 IF (INERR) THEN
WRITE(IOUT,FMT=6118)
IF (ONLINE) WRITE(ITOUT,FMT=6118)
GOTO 16
END IF
IF ((ISTAFLG.EQ.0).OR.(IENDFLG.EQ.0)) THEN
WRITE(IOUT,FMT=6088)
IF (ONLINE) WRITE(ITOUT,FMT=6088)
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6088)
CALL WINDIO(NULINE)
END IF
GOTO 16
END IF
6088 FORMAT(1X,'*** ERROR ***',/,1X,'START end END keywords',
+ ' must be given',/,1X,'Full list of possible keywords',
+ /,1X,'TESTGEN START 0 END 90 STEP 5 OVERLAP 4 MINOSC',
+ ' 0.3 MAXOSC 4',/,1X,'This will test phi values from',
+ ' 0 to 90 in steps of 5 degrees. At each phi value',/,1X,
+ 'the oscillation angle giving less than 4% overlapped',
+ ' spots will be determined',/,1X,'providing this is',
+ ' between 0.3 and 4 degrees')
IF (OSCANG.EQ.0) THEN
WRITE(IOUT,FMT=6090) PHSTART,PHEND,PHSTEP,XOVER(1),
+ OSCMIN,OSCMAX
IF (ONLINE) WRITE(ITOUT,FMT=6090) PHSTART,PHEND,PHSTEP,
+ XOVER(1),OSCMIN,OSCMAX
ELSE
WRITE(IOUT,FMT=6092) PHSTART,PHEND,PHSTEP,OSCANG
IF (ONLINE) WRITE(ITOUT,FMT=6092) PHSTART,PHEND,PHSTEP,
+ OSCANG
END IF
6090 FORMAT(1X,'Testing phi values from',F6.1,' to',F6.1,
+ ' in steps of',F4.1,' degrees.',/,1X,'At each phi value',
+ ' the oscillation angle giving less than',F5.1,
+ '% overlapped',/,1X,'SPOTS will be determined ',
+ 'providing this is between',F5.2,' and',F6.2,' degrees')
6092 FORMAT(1X,'Testing phi values from',F6.1,' to',F6.1,
+ ' in steps of',F4.1,' degrees.',/,1X,'At each phi value',
+ ' number of overlaps will be determined for an',/1X,
+ 'oscillation angle of',F6.2)
WRITE(IOUT,FMT=6093) 2*SETA/DTR,0.01*IXSEP,0.01*IYSEP
IF (ONLINE) WRITE(ITOUT,FMT=6093) 2*SETA/DTR,0.01*IXSEP,
+ 0.01*IYSEP
6093 FORMAT(/,1X,'The number of overlaps depends critically on ',
+ 'the estimated mosaic spread',/,1X,'(current value ',
+ F5.2,') and the minimum spot separation (currently ',
+ 2F5.2,'mm).',/,1X,'These values can be',
+ ' changed with MOSAIC and SEPARATION keywords.')
C
C---- HELP library
C
ELSE IF (KEY.EQ.'HELP') THEN
IF (WINOPEN) THEN
LINE = 'Use the terminal window when using HELP'
CALL MXDWIO(LINE,3)
END IF
HLPMOS = LINE
C
C ***************
CALL MOSHLP(HLPMOS)
C ***************
C
C---- RUN or GO
C
ELSE IF (KEY.EQ.'RUN ' .OR. KEY.EQ.'GO ' .or. testrat) THEN
NEWRUN = .TRUE.
IF (AUTO) GOTO 1
IF (TESTGEN) THEN
STRATEGY = .FALSE.
ETA = SETA
DIVH = SDIVH
DIVV = SDIVV
DELCOR = SDELCOR
DELAMB = SDELAMB
C
C---- If using a reduced cell to speed up strategy option, need to
C restore original cell for overlap calculation.
C
IF (SHRUNK) THEN
SHRUNK = .FALSE.
DO 36 I = 1,3
CELL(I) = CELL(I)*CELLSCAL
36 CONTINUE
IMAT = 1
IUMAT = 0
ICELL = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
WRITE(IOUT,FMT=6078) CELL
IF (ONLINE) WRITE(ITOUT,FMT=6078) CELL
6078 FORMAT(/,1X,'**** Restoring original cell parameters',
+ ' for TESTGEN option:',6F8.2)
END IF
CALL TESTOVER
IF(TESTRAT)THEN
TESTRAT = .FALSE.
TESTGEN = .FALSE.
ROTAUTO = 0.0
NSEGAUTO = 1
STRATEGY = .FALSE.
NSTRUN = 0
NSEGM = 0
FIRSTRAT = .TRUE.
NSTRAT = 0
NLAST = 1
NNPACKS = 0
NLASTPACK = 1
ISTRUN = 0
c---- Reset these to zero because otherwise if another STRATEGY run is done
C using the AUTO option after a run where the START,END values have
C been defined it will not generate the complete Laue Group rotation
C (in S/R ROTATE)
C
DO 395 I = 1,NSEGMAX
PHIST(I) = 0.0
PHIFIN(I) = 0.0
395 CONTINUE
IF (MTZOPEN) THEN
MTZPRT = 1
C *********************
CALL LWCLOS(MTZOUT,MTZPRT)
C *********************
MTZOPEN = .FALSE.
END IF
IF (SHRUNK) THEN
SHRUNK = .FALSE.
DO 410 I = 1,3
CELL(I) = CELL(I)*CELLSCAL
410 CONTINUE
IMAT = 1
IUMAT = 0
ICELL = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
WRITE(IOUT,FMT=6078) CELL
IF (ONLINE) WRITE(ITOUT,FMT=6078) CELL
END IF
RETURN
C
C---- end of tidying after TESTRAT
C
ENDIF
IF (CELLSCAL.NE.1.0) THEN
SHRUNK = .TRUE.
DO 42 I = 1,3
CELL(I) = CELL(I)/CELLSCAL
42 CONTINUE
IMAT = 1
IUMAT = 0
ICELL = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
WRITE(IOUT,FMT=6077) CELL
IF (ONLINE) WRITE(ITOUT,FMT=6077) CELL
6077 FORMAT(/,1X,'**** Restoring shrunk cell parameters',
+ ' for STRATEGY option:',6F8.2)
END IF
TESTGEN = .FALSE.
STRATEGY = .TRUE.
GOTO 16
END IF
GOTO 20
ELSE IF ((KEY.EQ.'EXIT').OR.(KEY.EQ.'END')) THEN
WRITE(IOUT,FMT=6080)
IF (ONLINE) WRITE(ITOUT,FMT=6080)
IF (.NOT.DONETEST) THEN
WRITE(IOUT,FMT=6081)
IF (ONLINE) WRITE(ITOUT,FMT=6081)
END IF
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6081)
CALL WINDIO(NULINE)
END IF
6080 FORMAT(/1X,'***** WARNING *****',/,1X,'The figures',
+ ' on completeness assume NO reflections are',
+ ' spatially overlapped',/,1X,'and no reflections',
+ ' are lost due to unmatched partials.')
6081 FORMAT(/,1X,'Use the TESTGEN option to determine',
+ ' appropriate oscillation angles to avoid',/,1X,
+ 'spatial overlaps.')
C
IF (WINOPEN) CALL MXDCIO(1,0,0,0,0)
ROTAUTO = 0.0
NSEGAUTO = 1
STRATEGY = .FALSE.
NSTRUN = 0
NSEGM = 0
FIRSTRAT = .TRUE.
NSTRAT = 0
NLAST = 1
NNPACKS = 0
NLASTPACK = 1
ISTRUN = 0
c
c---- Reset these to zero because otherwise if another STRATEGY run is done
C using the AUTO option after a run where the START,END values have
C been defined it will not generate the complete Laue Group rotation
C (in S/R ROTATE)
C
DO 39 I = 1,NSEGMAX
PHIST(I) = 0.0
PHIFIN(I) = 0.0
39 CONTINUE
IF (MTZOPEN) THEN
MTZPRT = 1
C *********************
CALL LWCLOS(MTZOUT,MTZPRT)
C *********************
MTZOPEN = .FALSE.
END IF
IF (SHRUNK) THEN
SHRUNK = .FALSE.
DO 40 I = 1,3
CELL(I) = CELL(I)*CELLSCAL
40 CONTINUE
IMAT = 1
IUMAT = 0
ICELL = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
WRITE(IOUT,FMT=6078) CELL
IF (ONLINE) WRITE(ITOUT,FMT=6078) CELL
END IF
RETURN
ELSE
WRITE (IOUT,FMT=6009) KEY
IF (ONLINE) WRITE (ITOUT,FMT=6009) KEY
6009 FORMAT (//1X,'********** Keyword NOT Recognised:',A)
INERR = .TRUE.
END IF
GOTO 16
C
C---- set up 4*sinsqth/lambdsq limits
C
20 DMAX = WAVE/DSTMIN
DMIN = WAVE/DSTMAX
STHLMIN = 1.0/ (DMAX)**2
STHLMAX = 1.0/ (DMIN)**2
STHINC = (STHLMAX-STHLMIN)/NBIN
IF (NEWRUN.AND.AUTO) THEN
IF (NSEGAUTO.EQ.1) THEN
WRITE(IOUT,FMT=6094)
IF (ONLINE) WRITE(ITOUT,FMT=6094)
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6210)
6210 FORMAT('Checking completeness of data')
CALL MXDWIO(LINE,1)
END IF
ELSE IF (NSEGAUTO.GE.2) THEN
WRITE(IOUT,FMT=6096) NSEGAUTO
IF (ONLINE) WRITE(ITOUT,FMT=6096) NSEGAUTO
IF (NSEGAUTO.GT.2) THEN
WRITE(IOUT,FMT=6098)
IF (ONLINE) WRITE(ITOUT,FMT=6098)
END IF
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6212) NSEGAUTO
6212 FORMAT('Testing to find the best combination of phi ',
+ 'values for the',I2,' segments')
CALL MXDWIO(LINE,1)
END IF
END IF
END IF
IF (NEWRUN) NEWRUN = .FALSE.
6094 FORMAT(/1X,'Checking completeness of data')
6096 FORMAT(/1X,'Testing to find the best combination of phi ',
+ 'values for the',I2,' segments')
6098 FORMAT(1X,'This may take some time......')
C
C
DO 22 I = 1,NBIN
STH = I*STHINC + STHLMIN
D(I) = SQRT(1.0/STH)
22 CONTINUE
C
C---- now sort segments into order of increasing phi
C
C
IF (NSEGIN.EQ.1) GO TO 60
C
C
DO 24 I = 1,NSEGIN
IPHIA(I) = NINT ( CPHIST(I) )
IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6172) I,IPHIA(I)
IF (ONLINE) WRITE(ITOUT,FMT=6172) I,IPHIA(I)
6172 FORMAT(1X,'Segment number',I3,' Starting phi',I5)
END IF
24 CONTINUE
C *************************
CALL SORTUP2(NSEGIN,IPHIA,JORDER)
C *************************
C
DO 56 I = 1,NSEGIN
J = JORDER(I)
ISPKST(I) = IPKST(J)
ISPKFI(I) = IPKFI(J)
SPHIST(I) = CPHIST(J)
SPHIFI(I) = CPHIFI(J)
SPHIINC(I) = CPHIINC(J)
56 CONTINUE
C
C
DO 58 I = 1,NSEGIN
IPKST(I) = ISPKST(I)
IPKFI(I) = ISPKFI(I)
CPHIST(I) = SPHIST(I)
CPHIFI(I) = SPHIFI(I)
CPHIINC(I) = SPHIINC(I)
58 CONTINUE
C
C
CAL WRITE (IOUT,FMT=6010) NSEGIN
CAL IF (ONLINE) WRITE (ITOUT,FMT=6010) NSEGIN
6010 FORMAT (1X,I3,' Input segments sorted on phi angle')
C
C
60 CONTINUE
C
IF (DEBUG(57)) THEN
WRITE(IOUT,FMT=6011)
IF (ONLINE) WRITE(ITOUT,FMT=6011)
END IF
6011 FORMAT(/1X,'The following predicted reflections will be ',
+ 'included in the analysis')
C
IRUNOLD = 0
DO 80 ISEG = 1,NSEGIN
CAL Next line is how it was, change it !
CAL IRUN = NINT(CPHIST(ISEG)-CPHIADD(ISEG))/360 + 1
IRUN = ICRUN(ISEG)
IF (IRUN.EQ.0) WRITE(IOUT,*)'ERROR...IRUN=0,ISEG=',ISEG
IF (IRUN.NE.IRUNOLD) THEN
IF (DEBUG(57).OR.LAST.OR.(.NOT.AUTO)) THEN
WRITE(IOUT,FMT=6110) IRUN
IF (ONLINE) WRITE(ITOUT,FMT=6110) IRUN
END IF
6110 FORMAT(1X,'Run number',I3)
IRUNOLD = IRUN
END IF
PHISTI = CPHIST(ISEG) - (IRUN-1)*360.0
PHIFINI = CPHIFI(ISEG) - (IRUN-1)*360.0
PHIINCI = CPHIINC(ISEG)
C
C---- Put into range for printing
C
PPHISTI = PHISTI
PPHIFINI = PHIFINI
IF (PPHISTI.GT.180) THEN
PPHISTI = PPHISTI - 360
PPHIFINI = PPHIFINI - 360
END IF
IPKS = IPKST(ISEG)
IPKF = IPKFI(ISEG)
IF (DEBUG(57).OR.LAST.OR.(.NOT.AUTO)) THEN
WRITE (IOUT,FMT=6012) PPHISTI,PPHIFINI,PHIINCI
IF (ONLINE) WRITE (ITOUT,FMT=6012) PPHISTI,PPHIFINI,PHIINCI
END IF
6012 FORMAT(1X,'From phi=',F6.1,' to',F6.1,' tabulating ',
+ 'statistics in steps of',F4.0,' degrees (STEP keyword)')
C
C---- calculate number of packs
C
NNPACK = NINT((PHIFINI-PHISTI)/PHIINCI)
IF (PHISTI+NNPACK*PHIINCI.LT.PHIFINI) NNPACK = NNPACK + 1
C
C
IF ((NPACK+NNPACK).GT.MAXPAX) THEN
WRITE (IOUT,FMT=6014) MAXPAX
IF (ONLINE) WRITE (ITOUT,FMT=6014) MAXPAX
6014 FORMAT (//2X,
+ '** ERROR, Number of Packs Exceeds Parameter ',
+ 'MAXPAX (',I3,') ',/1X,
+ 'Change MAXPAX in code and recompile')
C
C
END IF
C
C
DO 70 I = 1,NNPACK
J = I + NPACK
IPSSEG(J) = IPKS
IPFSEG(J) = IPKF
PRSTA(J) = (I-1)*PHIINCI + PHISTI
PRFIN(J) = I*PHIINCI + PHISTI
IF (I.EQ.NNPACK) PRFIN(J) = PHIFINI
IF (PRSTA(J).GT.180) THEN
PRSTA(J) = PRSTA(J) - 360
PRFIN(J) = PRFIN(J) - 360
END IF
CPHISTA(J) = (I-1)*PHIINCI + PHISTI+ (IRUN-1)*360
CPHIFIN(J) = I*PHIINCI + PHISTI + (IRUN-1)*360
IF (I.EQ.NNPACK) CPHIFIN(J) = PHIFINI + (IRUN-1)*360
70 CONTINUE
C
C
NPACK = NPACK + NNPACK
80 CONTINUE
C
NTOTPACK = NPACK
IF (DEBUG(57)) THEN
WRITE (IOUT,FMT=6018) NTOTPACK
IF (ONLINE) WRITE (ITOUT,FMT=6018) NTOTPACK
END IF
6018 FORMAT (/1X,I5,' Packs generated in TOTAL')
C
C
ICLEAR = 0
MULT = 0
NIN2 = 0
MAXMLT = 0
C
C---- Get the first (acceptable) reflection
C
100 NIN = NIN + 1
IF (NIN.GT.NTOTAL) GO TO 240
IP = IORDER(NIN)
DO 102 I = 1,MCOLSTR
ADATA1(I) = REAL(IHKLSTR(I,IP))
102 CONTINUE
IH = NINT(ADATA1(1))
IK = NINT(ADATA1(2))
IL = NINT(ADATA1(3))
C
IFLAG = NINT (ADATA1(4))
C
C---- Calculate IBIN here
C
C
C---- Calculate dstarsq in dimensionless rlu
C
DSTSQ = IH*IH*RCELL(1)*RCELL(1) +IK*IK*RCELL(2)*RCELL(2)
+ +IL*IL*RCELL(3)*RCELL(3) +
+ 2.0*IH*IK*RCELL(1)*RCELL(2)*COS(RCELL(6)*DTR) +
+ 2.0*IK*IL*RCELL(2)*RCELL(3)*COS(RCELL(4)*DTR) +
+ 2.0*IH*IL*RCELL(1)*RCELL(3)*COS(RCELL(5)*DTR)
C
S = DSTSQ/(WAVE**2)
IBIN = (S-STHLMIN)/STHINC + 1
C
C---- Check resolution limits, but only count
C unique reflections outside resolution limits
C
IF ((S.LT.STHLMIN).OR.(S.GT.STHLMAX)) THEN
IF (IFLAG.EQ.-999) NRESO = NRESO + 1
GO TO 100
END IF
IF (IBIN.LT.1) THEN
WRITE(IOUT,*)'IBIN,HKL',IBIN,IH,IK,IL
IBIN = 1
END IF
IF (IBIN.GT.NBIN) THEN
WRITE(IOUT,*)'IBIN,HKL',IBIN,IH,IK,IL
IBIN = NBIN
END IF
C
C---- Check that this is indeed a "unique" data record (flag=-999)
C
C
IF (IFLAG.NE.-999) THEN
C
IF (MONITOR) THEN
C
IF (NEXTRA.EQ.0) THEN
WRITE(IOUT,FMT=6005)
6005 FORMAT(/' Extra reflections that are not present in '/,
+ ' the unique set will be written to extras.dat'/)
ENDIF
ENDIF
NEXTRA = NEXTRA + 1
C
GO TO 100
END IF
C
C
NIN1 = 1
NUNIRES(IBIN) = NUNIRES(IBIN) + 1
C
C---- count no. of acentric terms
C
ICEN = NINT (ADATA1(5))
IF (ICEN .EQ. 1) THEN
NUNIANO(IBIN) = NUNIANO(IBIN) + 1
NUNIANOT = NUNIANOT + 1
END IF
C
C ****************************
C---- Get next reflection in list
C ****************************
C
110 NIN = NIN + 1
IF (NIN.GT.NTOTAL) GO TO 240
IP = IORDER(NIN)
DO 112 I = 1,MCOLSTR
ADATA2(I) = REAL(IHKLSTR(I,IP))
112 CONTINUE
C
C
C---- Test resolution limits on UNIQUE reflections only
C
IFLAG = NINT (ADATA2(4))
IF (DEBUG(57).AND.(NDBG.LT.NDEBUG(57))) THEN
WRITE(IOUT,FMT=6300) (ADATA2(I),I=1,MCOLSTR)
IF (ONLINE) WRITE(ITOUT,FMT=6300) (ADATA2(I),I=1,MCOLSTR)
6300 FORMAT(/,1X,'Next record read: ',10F8.0)
END IF
C
C
IF (IFLAG.EQ.-999) THEN
C
IH = NINT(ADATA2(1))
IK = NINT(ADATA2(2))
IL = NINT(ADATA2(3))
C
C
C---- Calculate dstarsq in dimensionless rlu
C
DSTSQ = IH*IH*RCELL(1)*RCELL(1) +IK*IK*RCELL(2)*RCELL(2)
+ +IL*IL*RCELL(3)*RCELL(3) +
+ 2.0*IH*IK*RCELL(1)*RCELL(2)*COS(RCELL(6)*DTR) +
+ 2.0*IK*IL*RCELL(2)*RCELL(3)*COS(RCELL(4)*DTR) +
+ 2.0*IH*IL*RCELL(1)*RCELL(3)*COS(RCELL(5)*DTR)
C
S = DSTSQ/(WAVE**2)
IBIN = (S-STHLMIN)/STHINC + 1
C
C---- Check resolution limits, but only count
C unique reflections outside resolution limits
C
IF ((S.LT.STHLMIN).OR.(S.GT.STHLMAX)) THEN
WRITE(IOUT,*)'Rejected sinthl limits',IFLAG,IH,IK,IL
NRESO = NRESO + 1
GO TO 110
END IF
IF (IBIN.LT.1) THEN
WRITE(IOUT,*)'IBIN,HKL',IBIN,IH,IK,IL
IBIN = 1
END IF
IF (IBIN.GT.NBIN) THEN
WRITE(IOUT,*)'IBIN,HKL',IBIN,IH,IK,IL
IBIN = NBIN
END IF
C
NUNIRES(IBIN) = NUNIRES(IBIN) + 1
C
C---- count number of acentric terms as a function of resolution
C
ICEN = NINT (ADATA2(5))
C
IF (ICEN.EQ.1) THEN
NUNIANO(IBIN) = NUNIANO(IBIN) + 1
NUNIANOT = NUNIANOT + 1
END IF
C
END IF
C
C---- If a generated reflection, check it is within desired segments
C
IBATCH = NINT (ADATA2(4))
C
C
IF (IBATCH.EQ.9999) THEN
C
C---- Note that PHI has been stored originally as a truncated real in an
C integer. This even though we are using NINT below, this will stilln
C be the tru phi truncated to the nearest smaller integer.
C
IPHI = NINT (ADATA2(5))
DO 120 ISEG = 1,NSEGIN
IF ((IPHI.GE.NINT(CPHIST(ISEG)).AND.
+ IPHI.LT.NINT(CPHIFI(ISEG)))) GOTO 125
120 CONTINUE
C
C---- Not in requested segments
C
GO TO 110
END IF
C
125 CONTINUE
C
C---- Test indices
C
DO 130 I = 1,3
HKL1(I) = NINT (KH(I))
HKL2(I) = NINT (LH(I))
130 CONTINUE
C
IF (HKLEQ(HKL1,HKL2)) THEN
C
C---- Test that ADATA2 is indeed an generated record (BATCH=9999)
C
IBATCH = NINT (ADATA2(4))
IF (IBATCH.NE.9999) THEN
WRITE (IOUT,FMT=6024) (ADATA1(JJ),JJ=1,MCOLSTR),
+ (ADATA2(KK),KK=1,MCOLSTR)
IF (ONLINE) WRITE (ITOUT,FMT=6024)
+ (ADATA1(JJ),JJ=1,MCOLSTR),(ADATA2(KK),KK=1,MCOLSTR)
6024 FORMAT (//2X,
+ '*** ERROR, ADATA2 is not an generated Record',/,1X,
+ 'ADATA1=',12F8.2,/1X,'ADATA2=',12F8.2)
C
C
END IF
C
C
NIN2 = NIN2 + 1
MULT = MULT + 1
IBINOLD = IBIN
ICENOLD = ICEN
C
C
IF (MULT.GT.MULTMAX) THEN
WRITE (IOUT,FMT=6026) MULTMAX
IF (ONLINE) WRITE (ITOUT,FMT=6026) MULTMAX
6026 FORMAT (//1X,
+ '*** ERROR ***',/1X,
+ ' There are more than ',I3,' observations of a reflection.',/,
+ ' Change parameter MULTMAX and recompile')
C
END IF
C
C---- extract pack number from the phi angle
C and the batch limits on each segment
C
C
C
DO 140 I = 1,NTOTPACK
IF ((IPHI.GE.NINT(CPHISTA(I))).AND.
+ (IPHI.LT.NINT(CPHIFIN(I)))) THEN
CAL + (IPHI.LE.NINT(CPHIFIN(I)))) THEN
NPACK = I
GOTO 150
END IF
140 CONTINUE
C
C---- Pack not found
C
WRITE (IOUT,FMT=6028) (ADATA2(J),J=1,MCOLSTR)
IF (ONLINE) WRITE (ITOUT,FMT=6028) (ADATA2(J),J=1,MCOLSTR)
6028 FORMAT (//1X,
+ '*** ERROR ***',/1X,
+ 'Cant find input pack for this reflection',/1X,F8.2)
C
C
150 NTOT(NPACK) = NTOT(NPACK) + 1
C
C---- store symmetry number to test for anomalous pairs
C
NISYM(MULT) = NINT (ADATA2(6))
C
C---- NUNI counts number of unique reflections observed in total
C
IF (MULT.EQ.1) THEN
NUNI = NUNI + 1
NUNIQA(NPACK) = NUNIQA(NPACK) + 1
NOBSRES(NPACK,IBIN) = NOBSRES(NPACK,IBIN) + 1
END IF
C
C---- Store pack number
C
IPACK(MULT) = NPACK
GO TO 110
ELSE
C
C---- hkl not equal...
C
C first check that we have got some measured observations
C
IF (MULT.EQ.0) GO TO 220
C
C---- the following code is awfull, sorry ****
C
C Set up multiplicities for observations as a function of pack
C
C First store number of observations of this hkl for each pack
C NDIFFPACK counts the number of different packs having this
C observation, and MULTPACK is the number of observations on each
C pack (stored in JPACK). NMULT keeps track of total number of
C observations for this hkl
C
NDIFFPACK = 0
IREF = 1
NMULT = 0
C
C
IF (DEBUG(57).AND.(NDBG.LT.NDEBUG(57))) THEN
NDBG = NDBG + 1
WRITE (IOUT,FMT=6030) KH,MULT, (IPACK(I),I=1,MULT)
IF (ONLINE) WRITE (ITOUT,FMT=6030) KH,MULT, (IPACK(I),
+ I=1,MULT)
6030 FORMAT (//,' Refl',3F5.0,6X,'Mult,Ipack',I5,5X,8I5)
END IF
C
C
DO 180 I = 1,MULT
C
C---- check if this observation is to be skipped because this pack
C has already been dealt with
C
IF (I.LT.IREF) GO TO 180
NPACK1 = IPACK(I)
MULTPACK = 1
NDIFFPACK = NDIFFPACK + 1
C
C
IF (NDIFFPACK.GT.MAXDIFF) THEN
WRITE (IOUT,FMT=6032) MAXDIFF
IF (ONLINE) WRITE (ITOUT,FMT=6032) MAXDIFF
6032 FORMAT (//1X,
+ '*** ERROR ***',/1X,
+ 'The limit on the number of different packs on which a ',/,
+ ' reflection can be observed ',/2X,
+ ' (currently ',I4,') has been exceeded',/1X,
+ 'Recompile the program increasing parameter MAXDIFF')
C
END IF
C
C
IF (I.EQ.MULT) GO TO 170
C
C---- see if any more observations from same pack
C
DO 160 J = I + 1,MULT
NPACK2 = IPACK(J)
IF (NPACK2.NE.NPACK1) GO TO 170
MULTPACK = MULTPACK + 1
160 CONTINUE
C
C---- store different pack numbers and cumulative number of
C observations from each pack
C
170 JPACK(NDIFFPACK,1) = NPACK1
JPACK(NDIFFPACK,2) = MULTPACK + NMULT
NMULT = NMULT + MULTPACK
IF (NMULT.GT.MULTMAX) THEN
WRITE(IOUT,FMT=6033) NMULT,MULTMAX
IF (ONLINE) WRITE(ITOUT,FMT=6033) NMULT,MULTMAX
6033 FORMAT(//1X,'*** ERROR ***',/,1X,'NMULT is',I6,
+ ' which exceeds limit of MULTMAX (',I6,')',/,1X,
+ 'Change PARAMETER MULTMAX and recompile program')
STOP
END IF
C
C---- set counter iref to skip any further observations in same pack
C at top of do loop
C
IREF = I + MULTPACK
180 CONTINUE
C
C
IF (DEBUG(57).AND.(NDBG.LT.NDEBUG(57))) THEN
WRITE (IOUT,FMT=6034) NDIFFPACK,NMULT,
+ ((JPACK(I,J),J=1,2),I=1,NDIFFPACK)
IF (ONLINE) WRITE (ITOUT,FMT=6034) NDIFFPACK,NMULT,
+ ((JPACK(I,J),J=1,2),I=1,NDIFFPACK)
6034 FORMAT (/,' Ndiffpack,Nmult',2I5,/1X,'Jpack',8 (2I5,5X))
END IF
C
C---- now accumulate totals
C
JPACK(NDIFFPACK+1,1) = NTOTPACK + 1
C
C
DO 200 I = 1,NDIFFPACK
NPACK1 = JPACK(I,1)
NPACK2 = JPACK(I+1,1) - 1
MULT = JPACK(I,2)
IF (MULT.GT.MAXMLT) MAXMLT = MULT
C
C
IF (DEBUG(57).AND.(NDBG.LT.NDEBUG(57))) THEN
WRITE (IOUT,FMT=6036) NPACK1,NPACK2,MULT
IF (ONLINE) WRITE (ITOUT,FMT=6036) NPACK1,NPACK2,MULT
6036 FORMAT (
+ ' Set up NTIMES for pack ',I5,' to ',I5,' Mult= ',I5)
END IF
C
C
DO 190 J = NPACK1,NPACK2
NTIMES(J,MULT) = NTIMES(J,MULT) + 1
190 CONTINUE
DO 192 J = NPACK1,NPACK2
SUM1 = 0
SUM2 = 0
DO 194 K = 1,MAXMLT
SUM1 = SUM1 + K*NTIMES(J,K)
SUM2 = SUM2 + NTIMES(J,K)
194 CONTINUE
XMULT(J) = 0.0
IF (SUM2.NE.0) XMULT(J) = SUM1/SUM2
192 CONTINUE
C
200 CONTINUE
C
C---- now test for presence of anomalous pairs in generated data,
C if this is an acentric reflection
C
IF ((NMULT.EQ.1) .OR. (ICENOLD.EQ.0)) GO TO 220
NANO = 0
C
C
DO 210 I = 2,NMULT
IF (NISYM(I).NE.NISYM(I-1)) NANO = 1
210 CONTINUE
C
C
NANOM(IBINOLD) = NANOM(IBINOLD) + NANO
NANOMT = NANOMT + NANO
C
C---- check that ADATA2 is indeed a unique record (flag=-999),
C if not skip to next record
C
220 IFLAG = NINT (ADATA2(4))
C
C
IF (IFLAG.NE.-999) THEN
NEXTRA = NEXTRA + 1
WRITE(IOUT,*)'EXTRA REFLECTION',(ADATA2(I),I=1,3)
C
C
C
C---- set mult=0 so the previous set of observations are not added
C in again
C
MULT = 0
GO TO 110
END IF
C
C---- transfer ADATA2 to to ADATA1 and read next record
C
DO 230 I = 1,MCOLSTR
ADATA1(I) = ADATA2(I)
230 CONTINUE
C
C
MULT = 0
NIN1 = NIN1 + 1
GO TO 110
END IF
C
C---- End of file, print statistics
C first cumulate number of unique reflections
C
240 CONTINUE
C
NPACK = NTOTPACK
C
C
DO 260 I = 1,NBIN
DO 250 J = 1,NPACK
NTOTRES(I) = NTOTRES(I) + NOBSRES(J,I)
250 CONTINUE
C
C
SN = NUNIRES(I)
SN2 = NUNIANO(I)
IF (SN.EQ.0) GO TO 260
C
C
PCENT(I) = (NTOTRES(I)*100.0)/SN
IF (SN2.EQ.0) GO TO 260
PCENTANO(I) = (NANOM(I)*100.0)/SN2
260 CONTINUE
C
C
IF (NPACK.EQ.1) GO TO 280
C
C
DO 270 I = 2,NPACK
NUNIQA(I) = NUNIQA(I-1) + NUNIQA(I)
IF (NIN1.NE.0) PCUNIQA(I) = 100*REAL(NUNIQA(I))/REAL(NIN1)
270 CONTINUE
C
C---- Percentage observed
C
280 IF (NIN1.NE.0) PC = (100.0*NUNI)/REAL(NIN1)
PC1 = PC
IF (NIN1.NE.0) PCUNIQA(1) = 100*REAL(NUNIQA(1))/REAL(NIN1)
IF (AUTANOM.AND.(NUNIANOT.GT.0)) PC = 100.0*NANOMT/REAL(NUNIANOT)
IF (IMODE.EQ.0) THEN
IF (DEBUG(57).OR.LAST.OR.(.NOT.AUTO)) THEN
IF (AUTANOM) THEN
WRITE(IOUT,FMT=6200) PC
IF (ONLINE) WRITE(ITOUT,FMT=6200) PC
IF (WINOPEN.AND.(.NOT.AUTO)) THEN
LINE = ' '
WRITE(LINE,FMT=6250) PC
6250 FORMAT('These segments contain',F6.1,'% of the possible',
+ ' anomalous pairs.')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6246)
CALL MXDWIO(LINE,3)
END IF
ELSE
WRITE(IOUT,FMT=6037) PC
IF (ONLINE) WRITE(ITOUT,FMT=6037) PC
IF (WINOPEN.AND.(.NOT.AUTO)) THEN
LINE = ' '
WRITE(LINE,FMT=6252) PC
6252 FORMAT('These segments contain',F6.1,'% of the',
+ ' unique data.')
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6246)
CALL MXDWIO(LINE,3)
END IF
IF (OFFPHI.AND.(NSEGAUTO.EQ.1).AND.(PCMAX.LT.99)) THEN
WRITE(IOUT,FMT=6320)
IF (ONLINE) WRITE(ITOUT,FMT=6320)
6320 FORMAT(1X,'*****************************************',
+ '***************************',/,1X,
+ 'It may be possible to get a higher ',
+ 'completeness using two segments,',/,1X,
+ 'or a slightly greater rotation angle.',/,1X,
+ '*****************************************',
+ '***************************')
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6320)
CALL WINDIO(NULINE)
END IF
END IF
IF (PHIPAD.NE.0) THEN
WRITE(IOUT,FMT=6039) PHILAUE+PHIPAD
IF (ONLINE) WRITE(ITOUT,FMT=6039) PHILAUE+PHIPAD
6039 FORMAT(1X,'It may be possible to get a slightly higher',
+ ' completeness (particularly at',/,1X,
+ 'low resolution) for a larger rotation range.',
+ /,1X,'Try: AUTO ROTATION',F6.1,' SEGMENT 1 to test',
+ ' this.')
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6039) PHILAUE+PHIPAD
CALL WINDIO(NULINE)
END IF
END IF
END IF
END IF
6037 FORMAT(1X,'These segments contain',F6.1,'% of the',
+ ' unique data.',/,1X,'Type "STATS" for full statistics')
6200 FORMAT(1X,'These segments contain',F6.1,'% of the possible',
+ ' anomalous pairs.',/,1X,'Type "STATS" for full statistics')
IF ((.NOT.AUTO).OR.LAST) THEN
WRITE(IOUT,FMT=6080)
IF (ONLINE) WRITE(ITOUT,FMT=6080)
WRITE(IOUT,FMT=6081)
IF (ONLINE) WRITE(ITOUT,FMT=6081)
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6081)
CALL WINDIO(NULINE)
END IF
END IF
IF (AUTO) THEN
C
C---- If this is last run with the best parameters, turn AUTO off
C
IF (LAST) THEN
LAST = .FALSE.
AUTO = .FALSE.
GOTO 16
END IF
C
C---- Store these results
C
IF (PC.GT.PCMAX) THEN
PCMAX = PC
DO 282 I = 1,NSEGAUTO
PHSBEST(I) = CPHIST(NSEGSTART+I-1)
282 CONTINUE
END IF
GOTO 400
END IF
GOTO 16
END IF
WRITE (IOUT,FMT=6038) NIN2,NUNI,PC1
IF (ONLINE) WRITE (ITOUT,FMT=6038) NIN2,NUNI,PC1
IF (AUTANOM) THEN
WRITE(IOUT,FMT=6202) PC
IF (AUTANOM) WRITE(ITOUT,FMT=6202) PC
END IF
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6038) NIN2,NUNI,PC1
CALL WINDIO(NULINE)
IF (AUTANOM) THEN
WRITE(IOLINE,FMT=6202) PC
CALL WINDIO(NULINE)
END IF
END IF
6038 FORMAT(/1X,'These segments contain',
+ I7,' predicted reflections and',
+ I7,' unique reflections',/,1X,'This is',F6.1,
+ ' percent of the unique data for this spacegroup.',
+ /,1X,' =====')
6202 FORMAT(1X,'Completeness of anomalous pairs is',F6.1,'%')
C
C---- Print warning if extra reflections exist in data file
C
IF (NEXTRA.NE.0) THEN
WRITE (IOUT,FMT=6040) NEXTRA
IF (ONLINE) WRITE (ITOUT,FMT=6040) NEXTRA
END IF
6040 FORMAT(/1X,'***** WARNING *****',/1X,'*******************',
+ /1X,I6,' predicted reflections',
+ ' that are not in list of unique reflections.',
+ /,1X,'This can arise if the predicted reflections are to a',
+ ' higher (or lower) resolution',/,1X,'than the unique',
+ ' reflections',
+ /1X,'Extra reflections have all been ignored in following',
+ ' analysis')
C
WRITE (IOUT,FMT=6044)
IF (ONLINE) WRITE (ITOUT,FMT=6044)
6044 FORMAT(/1X,'UNIQUE DATA AS A FUNCTION OF ROTATION RANGE',
+ /1X,'===========================================',
+ /1X,'For each rotation range the total number of ',
+ 'reflections within that'/1X,'range and the cumulative number',
+ ' of unique reflections generated is listed'/15X,'==========')
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6044)
CALL WINDIO(NULINE)
END IF
C
NBITS = NPACK/NACROSS + 1
N1 = -NACROSS + 1
C
C
DO 290 K = 1,NBITS
N1 = N1 + NACROSS
IF (N1.GT.NPACK) GO TO 290
N2 = N1 + NACROSS - 1
IF (N2.GT.NPACK) N2 = NPACK
C
C nprint=(n2-n1+1)
C
WRITE (IOUT,FMT=6046) (PRSTA(J),PRFIN(J),J=N1,N2)
WRITE (IOUT,FMT=6048) (NTOT(J),J=N1,N2)
WRITE (IOUT,FMT=6050) (NUNIQA(J),J=N1,N2)
WRITE (IOUT,FMT=6051) (PCUNIQA(J),J=N1,N2)
IF (WINOPEN) THEN
NULINE = .FALSE.
WRITE (IOLINE,FMT=6046) (PRSTA(J),PRFIN(J),J=N1,N2)
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6048) (NTOT(J),J=N1,N2)
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6050) (NUNIQA(J),J=N1,N2)
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6051) (PCUNIQA(J),J=N1,N2)
NULINE = .TRUE.
CALL WINDIO(NULINE)
END IF
IF (ONLINE) WRITE (ITOUT,FMT=6046) (PRSTA(J),PRFIN(J),
+ J=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6048) (NTOT(J),J=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6050) (NUNIQA(J),J=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6051) (PCUNIQA(J),J=N1,N2)
6046 FORMAT (/1X,'Angle',8X,4 (F5.0,' to ',F5.0,3X))
6048 FORMAT (1X,'Number ',4 (5X,I6,6X))
6050 FORMAT (1X,'Number unique',4 (5X,I6,6X))
6051 FORMAT (1X,'%age unique ',4 (5X,F6.1,6X))
290 CONTINUE
C
C
WRITE (IOUT,FMT=6052)
IF (ONLINE) WRITE (ITOUT,FMT=6052)
6052 FORMAT(//1X,'MULTIPLICITIES'/1X,'=============='/1X,
+ 'For each oscillation range the number of reflections ',
+ 'predicted',
+ ' once,twice,'/1X,'three times etc are listed. these numbers ',
+ ' are cumulative'/47X,'=========='/)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6052)
CALL WINDIO(NULINE)
END IF
N1 = -NACROSS + 1
C
C
DO 310 K = 1,NBITS
N1 = N1 + NACROSS
IF (N1.GT.NPACK) GO TO 310
N2 = N1 + NACROSS - 1
IF (N2.GT.NPACK) N2 = NPACK
WRITE (IOUT,FMT=6054) (PRSTA(J),PRFIN(J),J=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6054) (PRSTA(J),PRFIN(J),
+ J=N1,N2)
WRITE (IOUT,FMT=6056)
IF (ONLINE) WRITE (ITOUT,FMT=6056)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6054) (PRSTA(J),PRFIN(J),J=N1,N2)
NULINE = .FALSE.
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6056)
CALL WINDIO(NULINE)
END IF
C
C
DO 300 J = 1,MAXMLT
WRITE (IOUT,FMT=6058) J, (NTIMES(I,J),I=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6058) J, (NTIMES(I,J),I=N1,N2)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6058) J, (NTIMES(I,J),I=N1,N2)
CALL WINDIO(NULINE)
END IF
300 CONTINUE
WRITE(IOUT,FMT=6059) (XMULT(I),I=N1,N2)
IF (ONLINE) WRITE(ITOUT,FMT=6059) (XMULT(I),I=N1,N2)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6059) (XMULT(I),I=N1,N2)
NULINE = .TRUE.
CALL WINDIO(NULINE)
END IF
C
C
6054 FORMAT (/1X,'Angle',8X,4 (F5.0,' to ',F5.0,3X))
6056 FORMAT (1X,'Multiplicity')
6058 FORMAT (6X,I2,6X,4 (5X,I6,6X))
6059 FORMAT (1X,'Mean multiplicity',1x,F6.1,6X,3 (5X,F6.1,6X))
310 CONTINUE
C
C
C
WRITE (IOUT,FMT=6060)
IF (ONLINE) WRITE (ITOUT,FMT=6060)
6060 FORMAT (///1X,
+'Breakdown as a Function of Resolution',/1X,
+'=====================================')
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6060)
CALL WINDIO(NULINE)
END IF
C
C
WRITE (IOUT,FMT=6062)
IF (ONLINE) WRITE (ITOUT,FMT=6062)
6062 FORMAT(/1X,'For each rotation range, the number of newly',
+ ' predicted unique reflections'/1X,'is listed as a',
+ ' function of resolution'/,1X,'The D value given for ',
+ 'each bin is the high resolution limit for that bin')
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6062)
CALL WINDIO(NULINE)
END IF
N1 = -NACROSS + 1
C
C
DO 330 K = 1,NBITS
N1 = N1 + NACROSS
IF (N1.GT.NPACK) GO TO 330
N2 = N1 + NACROSS - 1
IF (N2.GT.NPACK) N2 = NPACK
NPRINT = N2 - N1 + 1
WRITE (IOUT,FMT=6064) (PRSTA(J),PRFIN(J),J=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6064) (PRSTA(J),PRFIN(J),
+ J=N1,N2)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6064) (PRSTA(J),PRFIN(J),J=N1,N2)
NULINE = .FALSE.
CALL WINDIO(NULINE)
END IF
C
C
DO 320 I = 1,NBIN
WRITE (IOUT,FMT=6066) D(I), (NOBSRES(N,I),N=N1,N2)
IF (ONLINE) WRITE (ITOUT,FMT=6066) D(I), (NOBSRES(N,I),
+ N=N1,N2)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6066) D(I), (NOBSRES(N,I),N=N1,N2)
IF (I.EQ.NBIN) NULINE = .TRUE.
CALL WINDIO(NULINE)
END IF
320 CONTINUE
C
C
6064 FORMAT (/3X,'D angle',2X,4 (F5.0,' to ',F5.0,3X))
6066 FORMAT (1X,F5.2,7X,4 (5X,I6,6X))
330 CONTINUE
C
C
C
C
WRITE (IOUT,FMT=6068)
IF (ONLINE) WRITE (ITOUT,FMT=6068)
WRITE (IOUT,FMT=6070) (D(I),NUNIRES(I),NTOTRES(I),PCENT(I),
+ I=1,NBIN)
IF (ONLINE) WRITE (ITOUT,FMT=6070) (D(I),NUNIRES(I),NTOTRES(I),
+ PCENT(I),I=1,NBIN)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6068)
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6070) (D(I),NUNIRES(I),NTOTRES(I),PCENT(I),
+ I=1,NBIN)
CALL WINDIO(NULINE)
END IF
6068 FORMAT(/1X,'The number of unique reflections and the ',
+ 'number and percentage of those'/1X,
+ 'predicted is given as a function of resolution.'
+ /,1X,'The D value given for ',
+ 'each bin is the high resolution limit for that bin.'
+ //1X,' D unique reflections predicted reflections',
+ ' percentage predicted')
6070 FORMAT (1X,F5.2,1X,I10,14X,I10,10X,F10.1)
C
C---- print statistics on anomalous data
C
C
C
IF (NUNIANOT.NE.0) PC = (100.0*NANOMT)/REAL(NUNIANOT)
WRITE (IOUT,FMT=6072) NANOMT,NUNIANOT,PC
IF (ONLINE) WRITE (ITOUT,FMT=6072) NANOMT,NUNIANOT,PC
6072 FORMAT (///1X,
+'ANOMALOUS DATA',/1X,
+'==============',/1X,
+'A total of',I7,
+' anomalous pairs have been predicted, out of a total',/,1X,
+'possible of',I7,' ie',F6.1,' percent.')
WRITE (IOUT,FMT=6074)
IF (ONLINE) WRITE (ITOUT,FMT=6074)
WRITE (IOUT,FMT=6076) (D(I),NUNIANO(I),NANOM(I),PCENTANO(I),
+ I=1,NBIN)
IF (ONLINE) WRITE (ITOUT,FMT=6076) (D(I),NUNIANO(I),NANOM(I),
+ PCENTANO(I),I=1,NBIN)
IF (WINOPEN) THEN
WRITE (IOLINE,FMT=6072) NANOMT,NUNIANOT,PC
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6074)
CALL WINDIO(NULINE)
WRITE (IOLINE,FMT=6076)(D(I),NUNIANO(I),NANOM(I),PCENTANO(I),
+ I=1,NBIN)
CALL WINDIO(NULINE)
END IF
6074 FORMAT(/1X,'The number of unique acentric reflections and the ',
+ 'number and percentage of',/,1X,'anomalous pairs predicted',
+ ' is given as a function of resolution.'
+ /,1X,'The D value given for ',
+ 'each bin is the high resolution limit for that bin.',
+ //1X,' D unique acentric generated anomalous pairs',
+ ' percentage ')
6076 FORMAT (1X,F5.2,1X,I10,14X,I10,10X,F10.1)
C
GOTO 2
C
END
C
C== COMPR ==
SUBROUTINE COMPR(KREC,IHD,LDUMP,NSPT)
C =====================================
C
C
C---- Compares current spot in 'process' with reflections
C specified in 'spotdump' input file, and
C sets logical variable ldump if the current reflection
C is to be dumped through ' badspots' output.
C
C---- Aug 82
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
C .. Scalar Arguments ..
INTEGER KREC,NSPT
LOGICAL LDUMP
C ..
C .. Array Arguments ..
INTEGER IHD(3,50)
C ..
C .. Local Scalars ..
INTEGER I,JREC,ISYM
C ..
C .. Local Arrays ..
INTEGER IH(7),IHKL(3),IHKLSYM(3)
C ..
C .. External Subroutines ..
EXTERNAL GETHKL,ASUGET
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C ..
C .. Common blocks ..
C
C
JREC = ABS(KREC)
C
C ***************
CALL GETHKL(JREC,IH)
C ***************
DO 2 I = 1,3
IHKL(I) = IH(I)
2 CONTINUE
C
DO 10 I = 1,NSPT
C
C---- Search all symmetry related reflections
C
DO 30 ISYM = 1,2*NSYMP
CALL ASUGET(IHKL,IHKLSYM,ISYM)
LDUMP = ((IHKLSYM(1).EQ.IHD(1,I)) .AND.
+ (IHKLSYM(2).EQ.IHD(2,I)) .AND.
+ (IHKLSYM(3).EQ.IHD(3,I)))
IF (LDUMP) GO TO 20
30 CONTINUE
10 CONTINUE
20 RETURN
C
C
END
C== CORRELATE ==
SUBROUTINE CORRELATE(OD,LRAS,ICOD,MASK,NXC,NYC,R)
C ================================================
C
C
C---- Calculate a correlation coefficient between peak profile in OD
C and central box profile in ICOD. As the profiles still have the
C background present, subtract the minimum value from all pixels
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NXC,NYC
REAL R,R1,R2
C ..
C .. Array Arguments ..
INTEGER LRAS(5),MASK(MAXBOX),OD(MAXBOX),ICOD(MAXBOX)
C ..
C .. Local Scalars ..
REAL SX,SXSQ,SXY,SY,SYSQ,OD1,OD2
INTEGER HX,HXC,HY,HYC,IJ,IJC,N,NC,NRX,NRY,P,Q,NXY,MINOD,I
C ..
C .. Local Arrays ..
INTEGER ODSUB(MAXBOX),ICODSUB(MAXBOX)
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
C ..
SAVE
C
C---- Find min value in OD
C
NXY = LRAS(1)*LRAS(2)
MINOD = 999999
DO 2 I = 1,NXY
IF (OD(I).LT.MINOD) MINOD = OD(I)
2 CONTINUE
C
C---- Subtract min value
C
DO 4 I = 1,NXY
ODSUB(I) = OD(I) - MINOD
4 CONTINUE
C
C---- Find min value in ICOD
C
NXY = NXC*NYC
MINOD = 999999
DO 6 I = 1,NXY
IF (ICOD(I).LT.MINOD) MINOD = ICOD(I)
6 CONTINUE
C
C---- Subtract min value
C
DO 8 I = 1,NXY
ICODSUB(I) = ICOD(I) - MINOD
8 CONTINUE
C
HX = LRAS(1)/2
HY = LRAS(2)/2
HXC = NXC/2
HYC = NYC/2
C
N = 0
SX = 0
SY = 0
SXY = 0
SXSQ = 0
SYSQ = 0
IJ = 0
IJC = 0
C
C
DO 20 P = -HX,HX
DO 10 Q = -HY,HY
IJ = IJ + 1
C
C
IF ((P.GE.-HXC) .AND. (P.LE.HXC) .AND. (Q.GE.-HYC) .AND.
+ (Q.LE.HYC)) THEN
IJC = IJC + 1
C
C
IF (MASK(IJC).GT.0) THEN
OD1 = ODSUB(IJ)
OD2 = ICODSUB(IJC)
SX = SX + OD1
SY = SY + OD2
SXY = OD1*OD2 + SXY
SXSQ = OD1*OD1 + SXSQ
SYSQ = OD2*OD2 + SYSQ
N = N + 1
END IF
END IF
10 CONTINUE
20 CONTINUE
C
C
R1 = 0.0
R2 = 0.0
IF (N.NE.0) R1 = SXSQ-SX*SX/N
IF (N.NE.0) R2 = SYSQ-SY*SY/N
IF ((R1.EQ.0.0).OR.(R2.EQ.0.0)) THEN
R = 0.0
RETURN
END IF
R = (SXY-SX*SY/N)/ (SQRT(R1)*SQRT(R2))
C
C
END
c create_image.f
c maintained by G.Winter
c 16th April 2002
c
c This subroutine is for the express and simple purpose of creating jpeg
c images for the socket from the in-memory image. Thus, I know nothing
c about how it got there or whether it is even present or no...
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
subroutine create_image(argc, argv, types, values)
c specification:
c
c 1. interpret the limits of the desired in screen coordinates, from the
c command line input (argv).
c 2. convert these limits into the frame of reference used by the in
c memory image.
c 3. obtain this section of `image', stored in /pelc/, and call write_jpeg,
c which is written in C, to create the jpeg and rotate it appropriately.
c 4. write the limits of the image, in an xml document, to the socket.
implicit none
c we'll probably need a bunch of includes here, to get hold of the image
c parameter defines the parameters, which set the dimensions of the array
c used to store image, which is declared in pel. scn has the definitions
c for nrec and iylen, and ioo includes the server information.
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/gui.f
c gui.h
c maintained by G.Winter
c 16th April 2002
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c This defines the variables and common blocks which are used by the
c new gui control routine. This will also be used in xdisp and control,
c to switch the new gui on!
c
c
logical gui_switch
integer nargs
parameter (nargs = 200)
common /gui/ gui_switch
C&&*&& end_include ../inc/gui.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
c startgw
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
c endgw
integer argc, types(nargs)
character*80 argv(nargs), word, secondword
character*1000 outline
real values(nargs)
c locally used variables
integer xmin, ymin, xmax, ymax, width, height
integer i, quality, factor, zoom
integer centrex, centrey, theta, invert
integer tlc(2), brc(2), centre(2)
integer costheta, sintheta, dx, dy
real radtheta
integer ipx, ipy
integer*2 spot_position(10000)
integer*2 pred_position(2 * nrefls)
c logicals used in the parsing
logical setsize, setfactor, thumbnail, spots, prediction
c functions and subroutines used herein
integer lenstr
external lenstr, create_image_help
external ccplwc, write_jpeg, jpeg_set_quality, jpeg_set_filename
c , get_translation_parameters
c initialize everything
xmin = 0
ymin = 0
xmax = 0
ymax = 0
width = 0
height = 0
quality = 85
theta = 0
invert = 0
zoom = -1
setsize = .false.
setfactor = .false.
thumbnail = .false.
spots = .false.
prediction = .false.
c parse the input
if(argc .ne. 1) then
word = argv(2)
call ccplwc(word)
if(word .eq. 'help') then
call create_image_help
return
end if
end if
i = 2
do while(i .lt. argc)
word = argv(i)
call ccplwc(word)
if(word .eq. 'xmin') then
if(types(i + 1) .eq. 2) then
xmin = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'ymin') then
if(types(i + 1) .eq. 2) then
ymin = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'xmax') then
if(types(i + 1) .eq. 2) then
xmax = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'ymax') then
if(types(i + 1) .eq. 2) then
ymax = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'width') then
if(types(i + 1) .eq. 2) then
width = nint(values(i + 1))
setsize = .true.
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'height') then
if(types(i + 1) .eq. 2) then
height = nint(values(i + 1))
setsize = .true.
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'quality') then
if(types(i + 1) .eq. 2) then
quality = nint(values(i + 1))
call jpeg_set_quality(quality)
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'theta') then
if(types(i + 1) .eq. 2) then
theta = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'zoom') then
if(types(i + 1) .eq. 2) then
zoom = nint(values(i + 1))
setfactor = .true.
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'filename') then
call jpeg_set_filename(argv(i + 1), lenstr(argv(i + 1)))
else if(word .eq. 'thumbnail') then
secondword = argv(i + 1)
call ccplwc(secondword)
if((secondword .eq. 'on') .or.
+ (secondword .eq. 'true') .or.
+ (secondword .eq. '1')) then
thumbnail = .true.
else
thumbnail = .false.
end if
else if(word .eq. 'spots') then
secondword = argv(i + 1)
call ccplwc(secondword)
if((secondword .eq. 'on') .or.
+ (secondword .eq. 'true') .or.
+ (secondword .eq. '1')) then
spots = .true.
else
spots = .false.
end if
else if(word .eq. 'prediction') then
secondword = argv(i + 1)
call ccplwc(secondword)
if((secondword .eq. 'on') .or.
+ (secondword .eq. 'true') .or.
+ (secondword .eq. '1')) then
prediction = .true.
else
prediction = .false.
end if
end if
i = i + 2
end do
c check the input parameters - if there's a mistake, return
if(setsize .and. setfactor) then
if(.not. socklo) then
write(*, *) 'Dont specify zoom and width/height - naughty'
end if
return
end if
c and get the memory-screen translation parameters
c call get_translation_parameters(theta, invert)
c and put it into real units and perform the translation
c could all of this be encapsulated into a clever subroutine?
c costheta and sintheta will be -1, 0, +1
radtheta = 4 * atan(1.0) * real(theta) / 180.0
costheta = nint(cos(radtheta))
sintheta = nint(sin(radtheta))
c this rotation should be performed about the centre of the image
c so we first need to translate the image centre to the coordinate
c frame of the display
centre(1) = costheta * nrec / 2 - sintheta * iylen / 2
centre(2) = sintheta * nrec / 2 + costheta * iylen / 2
c check that the limits of the image are not all 0, and if they are, make
c them the limits of the image
if(xmin .eq. xmax) then
xmin = 0
xmax = 2 * centre(1)
end if
if(ymin .eq. ymax) then
ymin = 0
ymax = 2 * centre(2)
end if
xmin = xmin - centre(1)
xmax = xmax - centre(1)
ymin = ymin - centre(2)
ymax = ymax - centre(2)
tlc(1) = costheta * xmin + sintheta * ymin
tlc(2) = - sintheta * xmin + costheta * ymin
brc(1) = costheta * xmax + sintheta * ymax
brc(2) = - sintheta * xmax + costheta * ymax
tlc(1) = tlc(1) + nrec / 2
tlc(2) = tlc(2) + iylen / 2
brc(1) = brc(1) + nrec / 2
brc(2) = brc(2) + iylen / 2
xmin = tlc(1)
ymin = tlc(2)
xmax = brc(1)
ymax = brc(2)
c check the limits on the image - make whole image if all zero
if((xmin .eq. 0) .and.
+ (ymin .eq. 0) .and.
+ (xmax .eq. 0) .and.
+ (ymax .eq. 0)) then
xmax = nrec
ymax = iylen
end if
c check size of image - make whole image if zero, else make a nice
c fraction of the original's size if this is a change
if((width .eq. 0) .or.
+ (height .eq. 0)) then
width = nrec
height = iylen
end if
centrex = (xmin + xmax) / 2
centrey = (ymin + ymax) / 2
c get a nice box size if the user didn't specify the factor, else use that
if(.not. setfactor) then
if(abs(xmax - xmin) .ge. width) then
factor = abs(nint(real(xmax - xmin) / real(width)))
xmin = centrex - factor * width / 2
xmax = centrex + factor * width / 2
factor = abs(nint(real(ymax - ymin) / real(height)))
ymin = centrey - factor * height / 2
ymax = centrey + factor * height / 2
factor = factor * -1
else
dx = xmax - xmin
dy = ymax - ymin
factor = abs(nint(real(width) / real(xmax - xmin)))
xmin = centrex - width / (2 * factor)
xmax = centrex + width / (2 * factor)
factor = abs(nint(real(height) / real(ymax - ymin)))
ymin = centrey - height / (2 * factor)
ymax = centrey + height / (2 * factor)
end if
else
if(zoom .gt. 0) then
width = abs((xmax - xmin) * zoom)
height = abs((ymax - ymin) * zoom)
factor = zoom
else
width = abs((xmax - xmin) / zoom)
height = abs((ymax - ymin) / zoom)
factor = zoom
end if
end if
tlc(1) = xmin
tlc(2) = ymin
brc(1) = xmax
brc(2) = ymax
c we should translate the image limits back into the screen frame, then
c write them into an XML document and send them to the GUI.
xmin = costheta * tlc(1) + sintheta * tlc(2)
ymin = - sintheta * tlc(1) + costheta * tlc(2)
xmax = costheta * brc(1) + sintheta * brc(2)
ymax = - sintheta * brc(1) + costheta * brc(2)
101 format('',
+ 'ok',
+ '', i4, '', i4, '',
+ '', i4, '', i4, '',
+ '')
c empty image warning
102 format('',
+ 'error',
+ 'Error loading image - dimensions 0',
+ '')
298 format('',
+ 'ok',
+ '', i5, '', i5,
+ '', i5, '', i5,
+ '')
299 format('')
c check for empty image
if((nrec .eq. 0) .or. (iylen .eq. 0)) then
outline = ' '
write(outline, fmt=102)
call write_socket_length(serverfd, lenstr(outline), outline)
return
end if
if(thumbnail) then
tlc(1) = 0
tlc(2) = 0
brc(1) = nrec
brc(2) = iylen
outline = ' '
write(outline, 298) 0, nrec, 0, iylen
call write_socket_section(serverfd, lenstr(outline),
+ outline)
call write_jpeg(serverfd, nrec, iylen, image,
+ 0, 0, factor, tlc, brc, 0, 0, 0)
outline = ' '
write(outline, 299)
call write_socket_length(serverfd, lenstr(outline),
+ outline)
return
end if
outline = ' '
write(outline, fmt=101) xmin, ymin, xmax, ymax
call write_socket_length(serverfd, lenstr(outline), outline)
write(*, *) outline
c next, generate the actual image
if(.not. socklo) serverfd = -1
if(spots) then
do i = 1, nspt
ipx = nint(xspt(i) / rast)
ipy = nint(yspt(i) * yscal / rast)
spot_position(2 * i - 1) = ipx
spot_position(2 * i) = ipy
end do
call write_jpeg_spots(serverfd, nrec, iylen, image, 0, 0,
+ factor, tlc, brc, 1, theta, invert, spot_position, nspt)
else if(prediction) then
write(*, *) 'Drawing ', nspot, ' spots'
do i = 1, nspot
ipx = ix(i)
ipy = iy(i)
pred_position(2 * i - 1) = ipx
pred_position(2 * i) = ipy
end do
call write_jpeg_predict(serverfd, nrec, iylen, image, 0, 0,
+ factor, tlc, brc, 1, theta, invert, pred_position, nspot)
c + irg)
else
call write_jpeg(serverfd, nrec, iylen, image, 0, 0,
+ factor, tlc, brc, 1, theta, invert)
end if
end
subroutine create_image_help
c this is just an explaination for the user so that they can find
c out how to use the `create_image' function ...
c
c
write(*, *) 'create_image help:'
write(*, *) 'keyword: meaning:'
write(*, *) 'xmin - ymax: the limits of the image'
write(*, *) 'width, height: the size of the resulting jpeg'
write(*, *) 'quality: the jpeg quality - use 50 - 80'
write(*, *) 'theta: the angle through which to rotate'
write(*, *) 'zoom: the zoom factor'
write(*, *) 'filename: an output filename'
write(*, *) 'thumbnail: return the image embedded in XML?'
write(*, *) 'The create_image function exists to make a JPEG',
$ ' image from the image in memory, returning the result to',
$ ' the socket if that is how you are connecting'
return
end
SUBROUTINE CRESOL(IX1, IY1, DISTANCE, THETA, WAVELENGTH, RESOL)
c =============================================================
c
c Calculate resolution of point (based on DETRES)
c
c Input:
c IX1, IY1 pixel coordinates in image
c distance detector distance (mm)
c theta detector angle (degrees)
c wavelength wavelength (A)
c
c Output:
c resol resolution in A
c
IMPLICIT NONE
C
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
INTEGER IX1, IY1
REAL DISTANCE, THETA, WAVELENGTH, RESOL
C
REAL VDCO(3), S0(3), DD(3,3), DN(3)
real camcon(10)
data camcon /10*0.0/
camcon(3) = distance
camcon(9) = -theta
C
C Source
S0(1) = 0.0
S0(2) = 0.0
S0(3) = 1.0
C Detector rotation
chrp28052001 CALL DDMAT(DISTANCE, THETA, DD, DN)
CALL DDMAT(DISTANCE, THETA, DD, DN)
chrp09072001 call dddn(camcon,dd,dn)
C
C Convert pixel to mm
chrp28052001 CALL PXTOMM(FLOAT(IX1), FLOAT(IY1), VDCO(1), VDCO(2))
C TYPE *,'coords in mm wrt direct beam',VDCO(1),VDCO(2)
chrp28052001 VDCO(3) = 1.0
CALL PXTOMM(FLOAT(IX1), FLOAT(IY1), VDCO(1), VDCO(2))
C TYPE *,'coords in mm wrt direct beam',VDCO(1),VDCO(2)
VDCO(3) = 1.0
C
CALL DETRES(DD, VDCO, S0, RESOL)
RESOL = RESOL * WAVELENGTH
C WRITE(6,*),'RESOL',RESOL
C
RETURN
END
C== CROSS ==
C
C
C
SUBROUTINE CROSS(A,B,C)
C =======================
C
C
C .. Array Arguments ..
REAL A(3),B(3),C(3)
C ..
C
C
C
C
A(1) = B(2)*C(3) - C(2)*B(3)
A(2) = B(3)*C(1) - C(3)*B(1)
A(3) = B(1)*C(2) - C(1)*B(2)
C
C
END
C== CRYSTHDR ==
SUBROUTINE CRYSTHDR
C ===================
C
C
IMPLICIT NONE
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- Store information in common /ORIENT/.
C This routine sets all variables in /ORIENT/ except
C PHISTT & PHIEND: also LBCELL if it is not in the file.
C
C .. Scalar Arguments ..
C INTEGER
C
C ..
C .. Array Arguments ..
C REAL
C ..
C .. Local Scalars ..
REAL DTOR,DELAMBX,DELCORX,ETAD,DIVHD,DIVVD,ALAMBD
INTEGER I,J
C CHARACTER GTITLE*80,CBUF*88
C ..
C .. Local Arrays ..
REAL E1AXIS(3),S0VEC(3)
CHARACTER ABC(3)*2, AXSLAB*8
C ..
C .. External Subroutines ..
C EXTERNAL
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/orient.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file orient.h
C---- START of include file orient.h
C Orientation block data
C
C This contains slots for all information that seems to be essential
C at present. Each group of parameters is padded at the end for future
C expansion.
C
C Data in the orientation block are referred to the "Cambridge"
C laboratory axis frame: x along the (idealized) X-ray beam, z along
C usual rotation axis E1 (omega on 3-axis system). The matrix Q converts
C a vector in the Madnes frame to the Cambridge frame. Note that the
C laboratory frame is essentially defined by the vectors e1,e2,e3 &
C source. It doesn't really seem necessary to carry through a whole lot
C of crystal and beam tensors, particularly as we have integrated
C intensities at this stage, but maybe someone will want to, using the
C allocated padding
C
C The general orientation equation is
C
C x = R M U B h
C
C where x position in laboratory frame
C R goniostat matrix
C M missetting angle matrix (if relevant, see MISFLG)
C PhiZ PhiY PhiX (PHIXYZ)
C U crystal orientation matrix UMAT
C B cell orthogonalization matrix, derived from cell dimensions
C h reflection indices
C
C Note that the description below is NOT is the same order as in the
C common block, in which all the integers come before all the reals
C (flagged as I or R in the description below)
C
CI NWORDS number of words in orientation block
CI NINTGR number of integers (first part of block,
C includes these counts)
CI NREALS number of reals
CI IORTYP type of orientation block (for possible future use, now = 0)
CI INTPAD(9) padding for future use (integers)
C
C--- Information for this crystal
C
CR CELLX(6) cell dimensions (A & degrees)
CI LBCELL(6) refinement flags for cell dimensions
CR UMATX(3,3) orientation matrix U. If MISFLG .gt. 0, U is the
C "standard" setting when PhiXYZ ==0
CI MISFLG status of "missetting" angles PHIXYZ
C = 0 PHIXYZ not used, all orientation in UMAT
C = 1 1 set of missetting angles (PHIXYZ(I,1))
C = 2 2 sets PHIXYZ(I,J), J=1,2
CR PHIXYZ(3,2) missetting angles at beginning & end of rotation
CI JUMPAX reciprocal axis closest to principle goniostat axis E1
C (only used for printing)
CI NCRYST crystal number: a crystal may contain several batches
CI LCRFLG type of crystal mosaicity information
C (=0 for isotropic, =1 anisotropic)
C *** CRYDAT(12) equivalenced to following ***
CR ETAD reflection width (full width) (degrees) (if LCRFLG=0)
C or
CR ETADH,ETADV horizontal & vertical reflection width (if LCRFLG=1)
CR rest of CRYDAT: padding for crystal information (eg more complicated
C mosaicity model)
C ***
C
C--- Information for this batch
C
CI LDTYPE type of data
C = 1 oscillation data (2D spots)
C = 2 area detector data (3D spots)
C = 3 Laue data
CR DATUM(3) datum values of goniostat axes, from which Phi is measured
C (degrees)
CR PHISTTX,PHIENDX start & stop values of Phi (degrees) relative to datum
CI JSCAXS goniostat scan axis number (=1,2,3, or =0 for
C multiple axis scan
CR SCANAX(3) rotation axis in laboratory frame (not yet implemented:
C only relevant if JSCAXS=0)
CR TIME1, TIME2 start & stop times in minutes
CI NBSCAL number of batch scales & Bfactors plus SD's
C (4 at present, BSCALE, BBFAC & sd's)
C set = 0 if batch scales unset
CR BSCALE batch scale
CR BBFAC batch temperature factor
C corresponding scale is exp(-2 B (sin theta/lambda)**2)
CR SDBSCL sd (Bscale)
CR SDBFAC sd (BBfac)
CR BATPAD(12) padding for batch information
C
C--- Crystal goniostat information
C
CI NGONAX number of goniostat axes (normally 1 or 3)
CI E1(3),E2(3),E3(3) vectors (in "Cambridge" laboratory frame, see below)
C defining the NGONAX goniostat axes
CC GONLAB(3) names of the three goniostat axes
CR GONPAD(12) padding for goniostat information
C
C--- Beam information
C
CR SOURCE(3) Idealized (ie excluding tilts) source vector
C (antiparallel to beam), in "Cambridge" laboratory frame
CR S0(3) Source vector (antiparallel ! to beam), in
C "Cambridge" laboratory frame, including tilts
CI LBMFLG flag for type of beam information following
C = 0 for ALAMBD, DELAMB only (laboratory source)
C = 1 ALAMBD,DELAMB,DELCORX,DIVHD,DIVVD (synchrotron)
C (other options could include white beam)
C *** BEMDAT(25) equivalenced to following ***
CR ALAMBD Wavelength in Angstroms
CR DELAMB dispersion Deltalambda / lambda.
CR DELCORX Correlated component of wavelength dispersion.
CR DIVHD Horizontal beam divergence in degrees.
CR DIVVD Vertical beam divergence (may be 0.0 for isotropic beam
C divergence.
CR rest of BEMDAT: padding for beam information
C (*** How much here for Laue? ***)
C ***
C
C--- Detector information
C
CI NDET number of detectors (current maximum 2)
C -- for each detector
CR DXn crystal to detector distance (mm)
CR THETAn detector tilt angle (=Madnes:tau2) (degrees)
CR DETLMn(2,2) minimum & maximum values of detector coordinates (pixels)
C (i,j): i = 1 minimum, = 2 maximum
C j = 1 Xdet, = 2 Ydet
C The exact detector frame is not important, but Ydet
C should be the axis ~ parallel to the pricipal
C rotation axis
CR DETPAD(33) padding for detector information
C
C
C ..
C .. Common blocks ..
INTEGER NWORDS,NINTGR,NREALS,IORTYP,LBCELL,MISFLG,
+ JUMPAXX,NCRYST,LCRFLG,LDTYPE,JSCAXS,NBSCAL,NGONAX,LBMFLG,
+ NDET,INTPAD
REAL CELLX,UMATX,PHIXYZ,CRYDAT,DATUM,
+ PHISTTX,PHIENDX,SCANAX,TIME1,TIME2,
+ BSCALE,BBFAC,SDBSCL,SDBFAC,BATPAD,E1,E2,E3,GONPAD,
+ SOURCE,S0,BEMDAT,
+ DX1,THETA1,DETLM1,DX2,THETA2,DETLM2,DETPAD
CHARACTER BTITLE*70, GONLAB*8
C
C---- MTZ orient common blocks
C
C.... (i) Character variables
C
COMMON /CORIEN/ BTITLE, GONLAB(3)
C
C.... (ii) Real/integer variables
C
COMMON /ORIENT/ NWORDS, NINTGR, NREALS,
C
C---- Now the Integer variables
+ IORTYP, LBCELL(6), MISFLG, JUMPAXX, NCRYST, LCRFLG, LDTYPE,
+ JSCAXS, NBSCAL, NGONAX, LBMFLG, NDET, INTPAD(9),
C
C---- Now the Real variables (Batch stuff first)
C
+ CELLX(6), UMATX(3,3), PHIXYZ(3,2), CRYDAT(12), DATUM(3),
+ PHISTTX, PHIENDX, SCANAX(3), TIME1, TIME2,
+ BSCALE, BBFAC, SDBSCL, SDBFAC, BATPAD(12),
C
C---- Now Real variables for goniostat and beam/detector info
C
+ E1(3), E2(3), E3(3), GONPAD(12), SOURCE(3),
+ S0(3), BEMDAT(25), DX1, THETA1, DETLM1(2,2),
+ DX2, THETA2, DETLM2(2,2), DETPAD(33)
C
C&&*&& end_include ../inc/orient.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C
C
C
C---- Note well the following equivalences: these are to allow for
C alternative definitions of crystal mosaicity, beam parameters, etc
C
C ..
C .. Equivalences ..
EQUIVALENCE (ETAD,CRYDAT(1))
EQUIVALENCE (BEMDAT(1),ALAMBD)
EQUIVALENCE (BEMDAT(2),DELAMBX)
EQUIVALENCE (BEMDAT(3),DELCORX)
EQUIVALENCE (BEMDAT(4),DIVHD)
EQUIVALENCE (BEMDAT(5),DIVVD)
C
C---- Save it
C
SAVE
C
C .. Data statements ..
DATA ABC/'a*','b*','c*'/
C Rotation axis E1AXIS, X-ray beam S0VEC
DATA E1AXIS /0.0,0.0,1.0/, S0VEC/-1.0,0.0,0.0/
C Axis name
DATA AXSLAB /'PHI'/
C ..
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
C---- Set word count for /ORIENT/.
C positions orientation blocks in output
C MTZ file, and setup all the orientation block data
C
NWORDS = MBLENG
NINTGR = MBLINT
NREALS = MBLREA
C Orientation block type 0 (only possibility at present)
IORTYP = 0
C
C---- Set LDTYPE
C
C = 0 '*** unknown data type ***'
C = 1 2D spots
C = 2 3D spots
C = 3 Laue data
C
LDTYPE = 1
C
C---- Set default batch scale and B factor (set later by ROTA/AGROVATA)
C
NBSCAL = 0
BSCALE = 1.0
BBFAC = 0.0
SDBSCL = 0.0
SDBFAC = 0.0
C
C---- Transfer cell dimensions
C
DO 10 I = 1,6
CELLX(I) = CELL(I)
10 continue
C
C---- Transfer UMAT
C
DO 14 I = 1,3
DO 12 J = 1,3
UMATX(J,I) = UMAT(J,I)
12 CONTINUE
14 CONTINUE
C
C---- Transfer missetting angles
DO 16 I = 1,3
PHIXYZ(I,1) = DELPHI(I)
16 CONTINUE
C
C---- Set final missets to equal initial missets for each image
C
DO 18 I = 1,3
PHIXYZ(I,2) = PHIXYZ(I,1)
18 CONTINUE
C
C---- Transfer phi start,end
C
PHISTTX = PHIBEG
PHIENDX = PHIEND
C
C---- Transfer mosaic spread, stored internally as half width in radians
C
ETAD = 2.0*ETA/DTOR
C
C---- Transfer horizonatl and vertical beam divergences
C
DIVHD = 2.0*DIVH/DTOR
DIVVD = 2.0*DIVV/DTOR
C
C---- Wavelength and dispersion/correlation
C
ALAMBD = WAVE
DELAMBX = DELAMB
DELCORX = DELCOR
C---- Orientation data type 1 stored in orientation block, ie Umat + Phixyz
MISFLG = 1
C
C---- All beam parameters set
LBMFLG = 1
C---- Isotropic mosaicity
LCRFLG = 0
C
C---- Set crystal goniostat information (assume single axis)
C
NGONAX = 1
DO 20, I=1,3
E1(I) = E1AXIS(I)
E2(I) = 0.0
E3(I) = 0.0
GONLAB(I) = ' '
C Source vector
SOURCE(I) = S0VEC(I)
S0(I) = SOURCE(I)
C Datum = 0
DATUM(I) = 0.0
C Scan axis (dummy)
SCANAX(I) = 0.0
20 CONTINUE
C
C---- Transfer JUMPAX
C
JUMPAXX = JUMPAX
C
C---- Fill padding GONPAD,BEMDAT,DETPAD,BATPAD,INTPAD
C
DO 22 I = 1,12
GONPAD(I) = 0.0
BATPAD(I) = 0.0
22 CONTINUE
DO 24 I = 6,25
BEMDAT(I) = 0.0
24 CONTINUE
DO 26 I = 1,33
DETPAD(I) = 0.0
26 CONTINUE
DO 28 I = 1,9
INTPAD(I) = 0
28 CONTINUE
C
GONLAB(1) = AXSLAB
JSCAXS = 1
C
C---- Set detector parameters
C
C Single detector
NDET = 1
C Detector distance (mm)
DX1 = XTOFD*0.01
C Detector swing angle (unknown)
THETA1 = 0.0
C
C---- Set detector limits. Use the detector pixel coordinates, rather than
C virtual detector coordinates.
C
DETLM1(1,1) = 0
DETLM1(2,1) = NREC
DETLM1(1,2) = 0
DETLM1(2,2) = IYLEN
C
C---- Dummy time limits
C
TIME1 = 0.0
TIME2 = 0.0
DX2 = 0.0
THETA2 = 0.0
DETLM2(1,1) = 0
DETLM2(2,1) = NREC
DETLM2(1,2) = 0
DETLM2(2,2) = IYLEN
C
C---- LBcell values
C
C
DO 30 I = 1,6
LBCELL(I) = LCELL(I)
30 CONTINUE
C
END
C
SUBROUTINE DDDN(CAMCON, DD, DN)
IMPLICIT NONE
C
C Subroutine to prepare matrix DD and vector DN from the camera constants.
C == --
C
C---- DEBUG(71) this subroutine, keywords DEBUG DDDN
C
C
C---- originally from MADNES (Albrecht Messerschmidt), made into F77 by Jim
C Pflugrath.
C
C---- CAMCON(1) = CCX } { beam error in X (10 micron units)
C (2) = CCY } distortions { " " " Y (10 micron units)
C (3) = crystal to detector distance (10 micron units)
C (4) = CCOMEGA in degrees about axis // to X (X-ray beam)
C (5) = TWIST in degrees about "vertical" axis // to Y (~PHI)
C (6) = TILT in degrees about "horizontal" axis // to Z, _|_ to Y
C and X-ray
C (7) = inclination angle of primary beam
C (8) = inclination angle of primary beam
C (9) = twotheta // (coaxial) in DEGREES to Y ( ~PHI)
C (10) = azimuthal "twotheta" _|_ in DEGREES to Y (~PHI)
C
C Explanations of DGDV and DGDS:
C
C DGDA(j,i) (R) Components 'j' of the detector rotation axes 'i'
C DGDV(j,i) (R) Components 'j' of detector vectors 'i' = dx, dy
C
C CAMCON(4-6) now are input in degrees. Change subroutine name to
C DDDN (was DD_DN) to make in F77.
C
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
REAL DTOR
C
c INCLUDE 'MADINC (GONDF)/NOLIST'
C
REAL CAMCON(10), DD(3, 3), DN(3), PO(3),DGDS(3),
* TAU321(3, 3), TAU32(3, 3), MIS321(3,3), DX(3), DY(3),
* DO(3),dgda(3,3),dgdv(3,3),Dum1(3),Dum2(3)
INTEGER I,ICOUNT
LOGICAL FIRSTTIME
EXTERNAL GN3CMP,MATVEC
DTOR = ATAN(1.0)/45.0
C
C See MADNES Phase III, Pp49ff (Paul Tucker) &
C Pp57ff (Albrecht Messerschmidt)
C
C
C | d d d |
C | xx yx ox |
C | |
C Arrange matrix dd = | d d d |
C | xy yy oy |
C | |
C | d d d |
C | xz yz oz |
C
C d = TAU3*TAU2*TAU1*DGDV(J, 1)
C x ==== ==== ==== ----------
C
C d = TAU3*TAU2*TAU1*DGDV(J, 2)
C y ==== ==== ==== ----------
C
C d = TAU3*TAU2*TAU1*DGDS
C o ==== ==== ==== ----
C
C Assign values to DGDS and PO
C ---- --
ICOUNT = 0
CALL CLEAR(DGDS)
DGDS(1) = CAMCON(3) !
DGDS(2) = CAMCON(2) ! this is t1 on P57 of MADNES Phase III
DGDS(3) = CAMCON(1) !
C
PO(1) = CAMCON(3)
PO(2) = 0.0
PO(3) = 0.0
c
c---- values for dgda obtained from Phil's madnes source and adapted for
C Mosflm axes
c
CALL CLEAR(DGDA)
DGDA(2,1) = 1.0
DGDA(1,2) = 1.0
DGDA(3,3) = 1.0
CALL CLEAR(DGDV)
DGDV(1,1) = 0.0 ! P0 (0,0,D0) - P0 (0,0,D0)
DGDV(2,2) = 1.0 ! PY (0,1,D0) - P0 (0,0,D0)
DGDV(3,1) = 1.0 ! PX (1,0,D0) - P0 (0,0,D0)
C
C Calculate rotation matrix TAU321 for the resultant
C rotation about the rotation axes of the detector
C goniostat and rotation/translation matrix TAU32 for the
C determination of DN
C --
CALL GN3CMP(CAMCON(10)*DTOR, CAMCON(9)*DTOR,
* 0.0, DGDA(1, 2), DGDA(1, 3), DGDA(1, 1),
* 0, 0, TAU321)
C
c in this construction tau321 = tau32
CALL MATCOPF(TAU32,TAU321,3,3)
C
c CALL GN3CMP(CAMCON(10)*DTOR, CAMCON(9)*DTOR, 0.0,
c * DGDA(1, 2), DGDA(1, 3), DGDA(1, 1), 0, 0, TAU32)
C
C
C Calculate rotation matrix MIS321 for the resultant
C rotation about the detector due to the missetting angles
C TLT, TWIST, CCOMEGA
C
c CALL GN3CMP(CAMCON(6)*DTOR, CAMCON(5)*DTOR,
c * CAMCON(4)*DTOR, DGDA(1, 2), DGDA(1, 3), DGDA(1, 1),
c * 0, 0, MIS321)
C
c CALL MATMUL3(TAU321,TAU321,MIS321)
c CALL MATCOPF(TAU32,TAU321,3,3)
CALL MATVEC(DX,TAU321,DGDV(1,1))
CALL MATVEC(DY,TAU321,DGDV(1,2))
CALL MATVEC(DN,TAU32,PO)
CALL MATVEC(DO,TAU321,DGDS)
C
DO 320 I = 1, 3
DD(I, 1) = DX(I)
DD(I, 2) = DY(I)
DD(I,3) = DO(I)
320 CONTINUE
C
RETURN
C
END
C
SUBROUTINE DDMAT(DISTANCE, THETA, DD, DN)
C =========================================
C
c Calculate detector matrix (based on DDDN)
c Assumes CCX,CCY = 0.0
c
c Input:
c distance detector distance (mm)
c theta detector angle (degrees)
c
c Output:
c dd(3,3) detector matrix
c dn(3) detector normal (assumes Tau1 = 0!)
c
IMPLICIT NONE
C
REAL DISTANCE, THETA
C
INTEGER I
REAL DD(3,3), TAUMAT(3,3), TAU(3), DN(3)
REAL XX(3), DX(3), YY(3), DY(3), DGDS(3), DO(3)
DATA XX/1.0,0.0,0.0/, YY/0.0,1.0,0.0/
C
C DETECTOR ROTATION
TAU(1) = THETA
TAU(2) = 0.0
TAU(3) = 0.0
CALL ROTMAT(TAU,TAUMAT,1)
C
DGDS(1) = 0.0
DGDS(2) = 0.0
DGDS(3) = -DISTANCE
CALL MATVEC(DX, TAUMAT, XX)
CALL MATVEC(DY, TAUMAT, YY)
CALL MATVEC(DO, TAUMAT, DGDS)
CALL MATVEC(DN, TAUMAT, DGDS)
C
DO 10, I = 1,3
DD(I, 1) = DX(I)
DD(I, 2) = DY(I)
DD(I, 3) = DO(I)
10 CONTINUE
C
RETURN
END
C== DET ==
C
SUBROUTINE DET(IMGP)
C
C---- Sets the detector type...image plate version
C
C ..
C .. Scalar arguments
LOGICAL IMGP
IMGP = .TRUE.
END
SUBROUTINE DETCAL(S1,DISTANCE,DDINV,DN,VDCC)
C ============================================
C
C Calculate position on detector
C
C Input:
C s1(3) diffracted beam vector
C distance detector distance
C dn(3) detector normal
C ddinv(3,3) inverse detector matrix
C
C Output:
C vdcc(3) position on detector (mm frame) relative to an origin
C at the detector normal at zero swing angle
C
IMPLICIT NONE
EXTERNAL DOT
REAL DOT
C
REAL S1(3), DISTANCE, DN(3), DDINV(3,3), VDCC(3)
REAL S1DN, TS(3)
C
S1DN = DOT(S1,DN)
IF (ABS(S1DN).GT.1.0E-8) CALL VMSCAL(TS, S1, DISTANCE**2/S1DN)
CALL MATVEC(VDCC, DDINV, TS)
RETURN
END
SUBROUTINE DETRES(DD, VDCO, S0, RES)
C
C Subroutine to determine the resolution of a reflection
C based on its detector coordinates.
C VDCO contains the observed detector coordinates.
C VDCO(3) = 1.0 to fulfill the matrix equation
C
C A. Messerschmidt
C Max-Planck-Institut fuer Biochemie
C D8033 Martinsried
C West Germany
C
C Old version gave the wrong answers.
C Rewritten by Ian Tickle, Birkbeck. 22-May-91.
C
C FORTRAN 77: No exceptions.
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
REAL RES
C ..
C .. Array Arguments ..
REAL DD(3,3), VDCO(3), S0(3)
C
REAL S(3)
INTEGER IER
C ..
C .. External Subroutines ..
EXTERNAL MATVEC,VADD,VNORM
C ..
C .. External Functions ..
REAL DOT
EXTERNAL DOT
C
C First the vector S = matrix DD * vector VDCO
C
CALL MATVEC(S, DD, VDCO)
C
C Normalise S.
C Note the error flag from VNORM should never be set !
C
CALL VNORM(S, S, IER)
C
C S is now the diffracted beam vector s1, so s = s0 + s1
C
CALL VADD(S, S0, S)
C
C 1 / ||S|| = RES relative r. l. units
C
RES = DOT(S,S)
IF (RES .NE. 0.0) THEN
RES = 1.0 / SQRT(ABS(RES))
ELSE
RES = 999.999999
ENDIF
RETURN
END
C== DISCR ==
SUBROUTINE DISCR(OD,IRAS,MASK,DISCRIM,IFAIL)
C =============================================
IMPLICIT NONE
C
C---- Evaluate ratio of central pixel value to largest pixel value
C in background, after subtracting background from both.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL DISCRIM
INTEGER IFAIL
C ..
C .. Array Arguments ..
INTEGER OD(MAXBOX),IRAS(5),MASK(MAXBOX)
C ..
C .. Local Scalars ..
REAL A,B,C
INTEGER HX,HY,IJ,IOD,P,Q,NXY,BKG,MAXBKG,MAXPK,NXX,NYY
C ..
C .. Local Arrays ..
C ..
C ..
C .. External Subroutines ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C
C .. Equivalences ..
EQUIVALENCE (ASPOT(9),A), (ASPOT(10),B), (ASPOT(11),C)
C
SAVE
C ..
C
NXX = IRAS(1)
NYY = IRAS(2)
HX = NXX/2
HY = NYY/2
NXY = NXX*NYY
C
IJ = 0
MAXBKG = 0
MAXPK = 0
C
C
DO 40 P = -HX,HX
C
DO 30 Q = -HY,HY
IJ = IJ + 1
IOD = OD(IJ)
IF (IOD.LE.NULLPIX) GOTO 30
BKG = P*A + Q*B + C
IF (MASK(IJ).LT.0) THEN
C
C Background pixels
C
BKG = IOD - BKG
IF (BKG.GT.MAXBKG) MAXBKG = BKG
ELSE IF (MASK(IJ).GT.0) THEN
C
C Peak pixels
C
IOD = IOD - BKG
IF (IOD.GT.MAXPK) MAXPK = IOD
END IF
C
30 CONTINUE
40 CONTINUE
C
C--- Subtract 1.5*SIGMA from maximum background before test
C
C WRITE(6,*),'MAXBKG, MAXPK',MAXBKG,MAXPK
MAXBKG = MAXBKG - 1.5*SQRT(GAIN*C)
IF (MAXBKG*DISCRIM.GT.MAXPK) IFAIL = 1
END
C== DOT ==
REAL FUNCTION DOT(A,B)
C ======================
C
C---- Dot product of two vectors
C
C
C .. Array Arguments ..
REAL A(3),B(3)
C ..
C
C
DOT = A(1)*B(1) + A(2)*B(2) + A(3)*B(3)
C
C
END
SUBROUTINE DOTG(SCALAR, V1, V2, N)
C
C Subroutine to calculate the dot product of the
C vectors V1 and V2. The result is the value
C SCALAR. The dimension of the vectors is N.
C
INTEGER N
REAL V1(N), V2(N), SCALAR
C
SCALAR = 0.0
C
DO 100 I = 1, N
SCALAR = SCALAR + V1(I) * V2(I)
100 CONTINUE
RETURN
END
SUBROUTINE DPSSEARCH(XMM,YMM,RMINFND,RMAXFND,NSPOT)
C
C This is an attempt at a peak searching routine written by Harry. It uses
C a simple hill-climbing algorithm to find the peaks...
C
C
C NOTE THAT WE ALSO HAVE TO convert to MM at the end of all this stuff,
C so we need the pixel size; RAST and RASTY (slow and fast directions
C on image; I think that RAST = RASTY for all except R-Axis)
C
C
C NEED some includes here...
C
IMPLICIT NONE
C
C---- External subroutines
C
EXTERNAL RDBLK,CBYTE,XDLSTR,LENSTR
C
C---- Extrinsic function
C
INTEGER INTPXL
C
C---- Parameters
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- Local scalars
C
INTEGER LENSTR,MAXVAL,OVERLOAD,ITEMP,
$ STEPY,STEPYD,I,II,J,K,L,IXP,IYP,IBUTTON,XDLSTR,IMAG,
$ XTEMP, NEWPIX,X_MAX, Y_MAX,ITHR,
$ TOP_EDGE, RIGHT_EDGE,ICT,JCT,KCT,LCT,MCT,N,
$ ACT,BCT,C,REALHI,
$ HI,MED,LO,KEEPX,KEEPY,ICHK,CHKPEAK,LSTPEAK,IMGCHK,ITESTM
REAL MEANPEAK,SIGPEAK,check1,MAXPEAK,MINSIG,NOISE_THRESH,
$ BACK_COUNT,SPOT_COUNT,RASTY,
$ RCHK,R1,R2,CEN_THRESH,CEN_THR_ROOT
LOGICAL SPLIT,HIGHTOP,SHIFTED,NEWSPOTS,autoind,istiled
CHARACTER LINE*100
C
C---- Local arrays
C
INTEGER ICOMP(8),ITESTI(8),IPNT(7,7),IBOX(7,7)
REAL RIBOX(7,7),MEAN(3),SD(3)
C
C---- Scalar arguments
C
REAL XMM,YMM,RMINFND,RMAXFND
INTEGER NSPOT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
SAVE
C
C START SETTING UP THE PARAMETERS ETC
C
DATA STEPY /3/,OVERLOAD /65535/
data imag /1/
RASTY = RAST / YSCAL
ITESTI(1) = -NREC-1
ITESTI(2) = -NREC
ITESTI(3) = -NREC+1
ITESTI(4) = -1
ITESTI(5) = +1
ITESTI(6) = NREC-1
ITESTI(7) = NREC
ITESTI(8) = NREC+1
DO 1400 JCT=1, 7
DO 1350 ICT=1,7
IPNT(ICT,JCT)=(4-ICT)*NREC+4-JCT
1350 ENDDO
1400 ENDDO
STEPYD = 2*STEPY
TOP_EDGE = IYLEN-STEPYD
RIGHT_EDGE = NREC-2*STEPYD
BACK_COUNT = 2*(2*STEPY+1)+4*STEPY-2
SPOT_COUNT = (2*STEPY-1)*(2*STEPY-1)
NOISE_THRESH = 1.75
CEN_THRESH = 1.1
CEN_THR_ROOT = SQRT(CEN_THRESH)
C
C Create popup notice
C
C WRITE(LINE,FMT=1000)
C 1000 FORMAT(1X,'Sorry! This option is not available yet.',
C $ ' YOU MUST ABORT or MOSFLM will crash!!.')
C L = LENSTR(LINE)
C IXP = 400
C IYP = 400
C hrp CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
C hrp + XDLSTR(' '),0,XDLSTR('OK'),2,XDLSTR('Abort'),
C hrp + 5,3,0,IBUTTON)
C hrp IF (IBUTTON.EQ.1) call mxdcio(1,0,0,0,0)
C
C start the peak search...
C
100 CONTINUE
NSPOT = 0
C
C assume everything's okay to start off with
C
IERRFLG = 0
C
C THIS GOES OVER THE WHOLE FRAME row by row
C
DO 350 J=STEPYD, TOP_EDGE ,9
R1 = (FLOAT(J)*RAST)-(XCEN/100.)
DO 340 I=STEPYD, RIGHT_EDGE ,9
R2 = (FLOAT(I)*RASTY)-(YCEN/100.)
RCHK = SQRT((R1*R1)+(R2*R2))
C
C resolution range check
C
IF ((RCHK .GE. RMINSP) .AND. (RCHK .LE. RMAXSP))
$ THEN
C
C X,Y HOLD THE INDICES J, I; we keep reassigning inside this loop so we
C have to re-set it inside this loop
C
XTEMP = I+(NREC*(J-1))
C
C Initial value for ITEMP (suggested peak centre...)
C
115 ITEMP = INTPXL(IMAGE(XTEMP))
IF (RCHK.EQ.0) THEN
ITHR = 0
ELSE
ITHR = BGOD(RCHK)
END IF
ISTILED = .FALSE.
DO 120 II=1,8
ICOMP(II) = INTPXL(IMAGE(XTEMP+ITESTI(II)))
IF(ICOMP(II).EQ.0)ISTILED=.TRUE.
120 ENDDO
IF(.NOT.ISTILED)THEN
NEWPIX = 0
C
C Pick the biggest of the eight neighbours
DO 130 II=1,8,1
IF (abs(ITEMP) .LT. abs(ICOMP(II))) THEN
ITEMP = ICOMP(II)
NEWPIX = ITESTI(II)
ENDIF
130 CONTINUE
IF (NEWPIX .NE. 0) THEN
XTEMP = XTEMP + NEWPIX
C
C If we have a new biggest pixel, go back and try again. If not, continue...
GOTO 115
ENDIF
if(thresh*ITHR.lt.itemp)then
MAXVAL=ITEMP
X_MAX = INT(XTEMP/NREC)+1
Y_MAX = XTEMP-NREC*(X_MAX-1)
C
C That's the highest local maximum, now to do some peak discrimination tests
C ...
C
C but return to here if the real peak centre is better described by a pixel
C with lower value
C
SHIFTED = .FALSE.
133 CONTINUE
DO 140 JCT=1,7
DO 135 ICT=1,7
IBOX(ICT,JCT)=
$ INTPXL(IMAGE(XTEMP+IPNT(ICT,JCT)))
IF(IBOX(ICT,JCT).EQ.0)ISTILED=.TRUE.
135 ENDDO
140 ENDDO
IF(.NOT.ISTILED)THEN
ACT = 1
BCT = 7
DO 190 C=1,3
N = 0
SD(C) = 0.0
MEAN(C) = 0.0
DO 160 JCT = ACT,BCT
DO 150 ICT = ACT,BCT
RIBOX(JCT,ICT)=FLOAT(IBOX(JCT,ICT))
N = N+1
MEAN(C) = MEAN(C)+RIBOX(JCT,ICT)
150 CONTINUE
160 CONTINUE
MEAN(C) = MEAN(C)/FLOAT(N)
DO 180 JCT = ACT,BCT
DO 170 ICT = ACT,BCT
SD(C) = SD(C) + (MEAN(C)-
$ RIBOX(JCT,ICT))**2
170 CONTINUE
180 CONTINUE
SD(C) = SQRT(SD(C)/FLOAT(N))
ACT = ACT + 1
BCT = BCT - 1
190 ENDDO
c
c test for a stripy feature
c
REALHI = 0
HI = 0
MED = 0
LO = 0
DO 230 JCT = 2,6
DO 220 ICT = 2,6
DO 210 LCT = -1,1,1
DO 200 MCT = -1,1,1
IF ((LCT.NE.0).OR.(MCT.NE.0))THEN
CHECK1 = ABS(RIBOX(JCT+LCT,
$ ICT+MCT)-RIBOX(JCT,ICT))
IF (CHECK1.LE.SD(3))LO=LO+1
IF ((CHECK1.GT.SD(3)).AND.
$ (CHECK1.LE.2*SD(3)))
$ MED=MED+1
IF ((CHECK1.GT.2*SD(3)).AND.
$ (CHECK1.LE.3*SD(3)))HI=HI+1
IF (CHECK1.GT.3*SD(3))
$ REALHI=REALHI+1
ENDIF
200 ENDDO
210 ENDDO
220 ENDDO
230 ENDDO
C
C check to see if there's a better centre for the spot; higher mean and
C smaller sigma, not necessarily where the biggest pixel is.
C
MAXPEAK = 0.0
MINSIG = 999999.9
KEEPX = 0
KEEPY = 0
DO 290 JCT=3,5
DO 280 ICT = 3,5
MEANPEAK = 0.0
SIGPEAK = 0.0
DO 250 LCT = -1,1,1
DO 240 MCT = -1,1,1
MEANPEAK = MEANPEAK +
$ RIBOX(JCT+LCT,ICT+MCT)
240 ENDDO
250 ENDDO
MEANPEAK = MEANPEAK/9.0
DO 270 LCT = -1,1,1
DO 260 MCT = -1,1,1
SIGPEAK = SIGPEAK + (MEANPEAK-
$ RIBOX(JCT+LCT,ICT+MCT))**2
260 ENDDO
270 ENDDO
C
C standard error of the mean
C
SIGPEAK = SQRT(SIGPEAK/9.0)
IF (SIGPEAK.LT.MINSIG) THEN
KEEPX = JCT
KEEPY = ICT
MAXPEAK = MEANPEAK
MINSIG = SIGPEAK
ENDIF
280 ENDDO
290 ENDDO
C
C--- only allow the peak centre to move 1 pixel at most.
C
IF(((KEEPX.EQ.4).AND.(KEEPY.EQ.4)).OR.(SHIFTED))
$ THEN
SHIFTED = .FALSE.
ELSE
SHIFTED = .TRUE.
XTEMP = Y_MAX-KEEPY+4+(NREC*(X_MAX+KEEPX-5))
GOTO 133
ENDIF
CHECK1 = FLOAT(REALHI+HI)/FLOAT(MED+LO)
C
IF ((CHECK1 .LT. 0.9).AND.(sd(1).gT.
$ sd(3)))THEN
C
c IF (MEAN(1).LT.MEAN(3))
c $ (MEAN(2).LT.MEAN(3)))
c $ (SD(2).GT.SD(3)).and.
c $ (SD(1).GT.SD(3)))
c $ THEN
C
C get a value for peak width and sigma...
C
IF (NSPOT.LT.5000) THEN
NSPOT = NSPOT + 1
IWXSPOT(NSPOT) = 5
IWYSPOT(NSPOT) = 5
chrp IWXSPOT(NSPOT) = 1
chrp IWYSPOT(NSPOT) = 1
chrp MAXPEAK = INTPXL(IMAGE(XTEMP))
chrp CHKPEAK = MAXPEAK/2
chrp LSTPEAK = 99999
chrp ICHK = XTEMP
c if(INTPXL(IMAGE(XTEMP).gt.20000))pause
chrp 300 ICHK = ICHK - 1
chrp IMGCHK = INTPXL(IMAGE(ICHK))
chrp IF ((IMGCHK.GT.CHKPEAK).AND.
chrp $ (IMGCHK.LT.LSTPEAK).AND.
chrp $ (IMGCHK.LE.MAXPEAK))THEN
chrp IWXSPOT(NSPOT)=IWXSPOT(NSPOT)+1
chrp LSTPEAK = IMGCHK
c print*,imgchk,chkpeak,rchk,maxpeak
chrp GOTO 300
chrp ENDIF
chrp ICHK = XTEMP
chrp 310 ICHK = ICHK + 1
chrp IMGCHK = INTPXL(IMAGE(ICHK))
chrp IF ((IMGCHK.GT.CHKPEAK).AND.
chrp $ (IMGCHK.LT.LSTPEAK).AND.
chrp $ (IMGCHK.LE.MAXPEAK))THEN
chrp IWXSPOT(NSPOT)=IWXSPOT(NSPOT)+1
chrp LSTPEAK = IMGCHK
c print*,imgchk,chkpeak,rchk,maxpeak
chrp GOTO 310
chrp ENDIF
chrp ICHK = XTEMP
chrp 320 IF(ICHK.GT.NREC)THEN
chrp ICHK = ICHK - NREC
chrp IMGCHK = INTPXL(IMAGE(ICHK))
chrp IF ((IMGCHK.GT.CHKPEAK).AND.
chrp $ (IMGCHK.LT.LSTPEAK).AND.
chrp $ (IMGCHK.LE.MAXPEAK))THEN
chrp IWYSPOT(NSPOT)=IWYSPOT(NSPOT)+1
chrp LSTPEAK = IMGCHK
c print*,imgchk,chkpeak,rchk,maxpeak
chrp GOTO 320
chrp ENDIF
chrp ENDIF
chrp ICHK = XTEMP
chrp 325 ICHK = ICHK + NREC
chrp IMGCHK = INTPXL(IMAGE(ICHK))
chrp IF ((IMGCHK.GT.CHKPEAK).AND.
chrp $ (IMGCHK.LT.LSTPEAK).AND.
chrp $ (IMGCHK.LE.MAXPEAK))THEN
chrp IWYSPOT(NSPOT)=IWYSPOT(NSPOT)+1
chrp LSTPEAK = IMGCHK
c print*,imgchk,chkpeak,rchk,maxpeak
chrp GOTO 325
chrp ENDIF
if((IWXSPOT(NSPOT).gt.1).and.
$ (IWySPOT(NSPOT).gt.1))then
if(IWXSPOT(NSPOT).gt.5)iwxspot(nspot)=5
if(IWySPOT(NSPOT).gt.5)iwyspot(nspot)=5
IWXSPOT(NSPOT)=IWXSPOT(NSPOT)*1.5
IWYSPOT(NSPOT)=IWYSPOT(NSPOT)*1.5
c print*,iwxspot(nspot),iwyspot(nspot)
XSPT(NSPOT) = FLOAT(X_MAX) * RAST
YSPT(NSPOT) = FLOAT(Y_MAX) * RASTY
ISPT(NSPOT) = abs(MAXPEAK-bgod(rchk))
ISDSPT(NSPOT) = SQRT(MAXPEAK)/4
ISTIMG(IMAG) = 1
IENDIMG(IMAG) = NSPOT
XSPOT(NSPOT) = XSPT(NSPOT)
YSPOT(NSPOT) = YSPT(NSPOT)
INSPOT(NSPOT) = ISPT(NSPOT)
ISDSPOT(NSPOT) = ISDSPT(NSPOT)
RSPOT(NSPOT) = RCHK
else
nspot=nspot-1
endif
ENDIF
C
C end of resolution check
330 CONTINUE
ENDIF
ENDIF
endif
ENDIF
ENDIF
340 ENDDO
350 ENDDO
C
C now set all values of the image back to positive
C
if(nspot.lt.20)thresh=thresh/1.5
c pause
C CALL WSPOT(1)
c NEWSPOTS = .TRUE.
c AUTOIND = .TRUE.
c CALL MENSAVE(AUTOIND,NEWSPOTS)
C
C.... Try displaying spots here
C CALL DSPSPT(NSPOT)
C
C this is the other half of the XDLF_POPUP_NOTICE from the top of this file!
C
Ccccc ELSE
ccccc IERRFLG = 1
Ccccc ENDIF
RETURN
END
SUBROUTINE DSPADJ(LHELP)
C
C---- Write instructions on how to adjust image
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
LOGICAL LHELP
C ..
C .. Local Scalars ..
INTEGER IXW,IYW,LINELEN,NUMLIN
CHARACTER LINE*80
IXW = 200
IYW = 200
LINELEN = 58
NUMLIN = 17
IF (.NOT.LHELP) NUMLIN = 8
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXW,IYW)
IF (.NOT.LHELP) THEN
WRITE(LINE,6040)
6040 FORMAT(1X,'Adjusting fit between observed and calculated',
+ ' pattern.')
CALL MXDWIO(LINE, 2)
RETURN
END IF
WRITE (LINE, 6000)
6000 FORMAT(1X,'Adjust fit between observed and calculated pattern.')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6002)
6002 FORMAT (1X, 'Use the mouse to click first on a calculated spot')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6004)
6004 FORMAT (1X,'position and then on the actual spot position.')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6006)
6006 FORMAT (1X, 'Repeat this for another pair of calculated and')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6008)
6008 FORMAT (1X, 'observed spot positions')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6010)
6010 FORMAT (1X, 'The transformation required to match up these')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6012)
6012 FORMAT (1X, 'spots will be calculated and you will be given the')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6014)
6014 FORMAT (1X, 'option of accepting or rejecting the transformation')
CALL MXDWIO(LINE, 2)
END
C
C
C
C
SUBROUTINE DSPAVG(IMAGE,NYPIX,NXPIX,IX,IY,IX2,IY2,PXAVG,PXRMS,
+ NPX)
C =================================================================
C
c Calculate mean & rms of selected region of image
c
c Input
c image(NYPIX,NXPIX) image
c IX,IY 1st corner of box
c IX2,IY2 2nd corner of box
c
c Output
c pxavg average value
c pxrms rms deviation
c npx number of pixels
C
C
INTEGER NYPIX,NXPIX, IY,IX, IY2,IX2, NPX
INTEGER*2 IMAGE(NYPIX, NXPIX)
REAL PXAVG,PXRMS
C
C
INTEGER I, J, INCY, INCX
REAL VAL
C
INTEGER INTPXL
EXTERNAL INTPXL
C
INCY = SIGN(+1,IY2-IY)
INCX = SIGN(+1,IX2-IX)
NPX = ABS((IY2-IY)*(IX2-IX))
PXAVG = INTPXL(IMAGE(IY,IX))
PXRMS = 0.0
IF (NPX .EQ. 0) RETURN
PXAVG = 0.0
C
NPX = 0
DO 10, J = IX,IX2,INCX
DO 20, I = IY,IY2,INCY
VAL = INTPXL(IMAGE(I,J))
PXAVG = PXAVG + VAL
PXRMS = PXRMS + VAL*VAL
NPX = NPX+1
20 CONTINUE
10 CONTINUE
C
PXAVG = PXAVG/NPX
PXRMS = PXRMS/NPX - PXAVG*PXAVG
IF (PXRMS .GE. 0.0) THEN
PXRMS = SQRT(PXRMS)
ELSE
PXRMS = 0.0
ENDIF
C
C
RETURN
END
C== DSPBAD ==
C
SUBROUTINE DSPBAD
C ========================
C
C---- Loop over reflections in generate file and draw crosses at
C positions of bad spots.These are symbols and can be deleted with MXDDSY
C
C
IMPLICIT NONE
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Local Scalars ..
INTEGER I,IFLAG,IXPIX(1),IYPIX(1),ISTAT,ICOLR,ICSIZE,
+ ICOL,ICOLOV,ICOLEDGE
REAL XC,YC,XCAL,YCAL
LOGICAL OVERL,EDGE
C ..
C .. Common blocks ..
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
SAVE
DATA ICOLR/1/,ICOLOV/3/,ICOLEDGE/5/
ICSIZE = 5
IF (NZOOM.GT.0) ICSIZE = 8
C
DO 10 I = 1,TOSPT
IFLAG = IGFLAG(I)
C
C---- IGFLAG= -1 for badspots except PKRATIO ones (where only profile fitted
C measurement is rejected by default)
C = -2 for PKRATIO badspots
C = -3 overload
C** IF ((IFLAG.NE.-1).AND.(IFLAG.NE.-2).AND.(IFLAG.NE.-3)) GOTO 10
IF (IFLAG.GE.0) GOTO 10
IFLAG = ABS(IFLAG)
OVERL = (IFLAG.EQ.32)
EDGE = (IFLAG.EQ.64)
XC = XG(I)
YC = YG(I)
C
C---- Convert coords to pixels
C
C
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert XCAL,YCAL to pixels
C
IXPIX(1) = FACT*XCAL
IYPIX(1) = FACT*YCAL
C
C---- check within image
C
CALL CNVPIX(IXPIX,IYPIX, ISTAT)
IF (ISTAT .EQ. 0) THEN
C
C---- Draw a cross
C
ICOL = ICOLR
IF (OVERL) ICOL = ICOLOV
IF (EDGE) ICOL = ICOLEDGE
CALL DSPCRS(IXPIX,IYPIX,1,ICOL,ICSIZE)
ENDIF
10 CONTINUE
C
END
C== DSPBGD ==
SUBROUTINE DSPBGD
C =================
C
IMPLICIT NONE
C
C---- Display the rectangle used to determine the radial background
C ..
C .. Scalar Arguments ..
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Local Scalars ..
INTEGER IXCEN,IYCEN,IRMIN,IRMAX,IXOFF,IYOFF,NOFF,MAGUPD,IERR,
+ IX1,IY1,IX2,IY2
C ..
C .. Local Arrays ..
C INTEGER
C ..
C .. External Subroutines ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C ..
C .. Equivalences ..
C
C
C
C---- Convert to image pixels
C
IXCEN = 0.01*XCEN/RAST
IYCEN = 0.01*YCEN/RAST
IRMIN = NINT(RMINSP/RAST)
IRMAX = NINT(RMAXSP/RAST)
IXOFF = NINT(XOFFSET/RAST)
IYOFF = NINT(YOFFSET/RAST)
NOFF = NPIXBG/2
IF (RADX) THEN
IX1 = IXCEN + IRMIN
IX2 = IXCEN + IRMAX
IY1 = IYCEN - NOFF + IYOFF
IY2 = IY1 + NPIXBG
ELSE IF (RADY) THEN
IX1 = IXCEN - NOFF + IXOFF
IX2 = IX1 + NPIXBG
IY1 = IYCEN + IRMIN
IY2 = IYCEN + IRMAX
END IF
CALL XDLF_IMAGE_VECT(IVHIMG,IRV_VEC,IX1,IY1,IX2,IY1,
+ IRV_COL,IRV_OVL,MAGUPD,IERR)
CALL XDLF_IMAGE_VECT(IVHIMG,IRV_VEC,IX2,IY1,IX2,IY2,
+ IRV_COL,IRV_OVL,MAGUPD,IERR)
CALL XDLF_IMAGE_VECT(IVHIMG,IRV_VEC,IX2,IY2,IX1,IY2,
+ IRV_COL,IRV_OVL,MAGUPD,IERR)
CALL XDLF_IMAGE_VECT(IVHIMG,IRV_VEC,IX1,IY2,IX1,IY1,
+ IRV_COL,IRV_OVL,MAGUPD,IERR)
IF (IERR.NE.0) WRITE(6,*)'xdlf_image_vect error',IERR
RETURN
END
SUBROUTINE DSPBOX(IX, IY, N, ICOLR,IXSIZE,IYSIZE)
C =================================================
c
c Draw boxes at N points with image pixel coordinates IX, IY, colour icolr,
c size IXSIZE,IYSIZE image pixels.
C
C ICOLR = 1 Red
C = 2 Yellow
C = 3 Green
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C
C .. Scalar Arguments ..
INTEGER N,ICOLR,IXSIZE,IYSIZE
C
C .. Array Arguments ..
INTEGER IX(N), IY(N)
C ..
C .. Local Scalars ..
INTEGER I,NVEC,ISTAT,IXS,IXF,IYS,IYF,IXSZ,IYSZ,IXF1,IXF2,IYF1,
+ IYF2,MAGUPD
REAL XSIZE,YSIZE,XPIX,YPIX
C ..
C .. External Subroutines ..
EXTERNAL CHKBOX
C ..
C .. Common blocks ..
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/spvect.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spvect.h
C---- START of include file spvect.h
C
C
C .. Scalars in common block /SPVECT/ ..
INTEGER NRESID,IDVECT
C
C
C .. Arrays in Common Block /SPVECT/ ..
INTEGER IXSBOX,IYSBOX,IXFBOX,IYFBOX
INTEGER*2 ITXVECT
C ..
C .. Common Block /SPVECT/ ..
COMMON /SPVECT/ IXSBOX(4*NREFLS),IYSBOX(4*NREFLS),
+ IXFBOX(4*NREFLS),IYFBOX(4*NREFLS),
+ NRESID,IDVECT,ITXVECT(NREFLS*5)
C ..
C
C
C&&*&& end_include ../inc/spvect.f
C
INTEGER IERR
C
SAVE
IXSZ = IXSIZE/2
IYSZ = IYSIZE/2
XSIZE = IXSZ
YSIZE = IYSZ
NVEC = 0
C
DO 10 I = 1,N
IXS = IX(I) - XSIZE
IYS = IY(I) - YSIZE
IXF = IX(I) - XSIZE
IYF = IY(I) + YSIZE
ISTAT = 0
CALL CHKBOX(IXS,IYS,IXF,IYF,ISTAT)
IF (ISTAT.EQ.0) THEN
NVEC = NVEC + 1
IXSBOX(NVEC) = IXS
IYSBOX(NVEC) = IYS
IXFBOX(NVEC) = IXF
IYFBOX(NVEC) = IYF
END IF
C
IXS = IX(I) - XSIZE
IYS = IY(I) + YSIZE
IXF = IX(I) + XSIZE
IYF = IY(I) + YSIZE
ISTAT = 0
CALL CHKBOX(IXS,IYS,IXF,IYF,ISTAT)
IF (ISTAT.EQ.0) THEN
NVEC = NVEC + 1
IXSBOX(NVEC) = IXS
IYSBOX(NVEC) = IYS
IXFBOX(NVEC) = IXF
IYFBOX(NVEC) = IYF
END IF
C
IXS = IX(I) + XSIZE
IYS = IY(I) - YSIZE
IXF = IX(I) + XSIZE
IYF = IY(I) + YSIZE
ISTAT = 0
CALL CHKBOX(IXS,IYS,IXF,IYF,ISTAT)
IF (ISTAT.EQ.0) THEN
NVEC = NVEC + 1
IXSBOX(NVEC) = IXS
IYSBOX(NVEC) = IYS
IXFBOX(NVEC) = IXF
IYFBOX(NVEC) = IYF
END IF
C
IXS = IX(I) - XSIZE
IYS = IY(I) - YSIZE
IXF = IX(I) + XSIZE
IYF = IY(I) - YSIZE
ISTAT = 0
CALL CHKBOX(IXS,IYS,IXF,IYF,ISTAT)
IF (ISTAT.EQ.0) THEN
NVEC = NVEC + 1
IXSBOX(NVEC) = IXS
IYSBOX(NVEC) = IYS
IXFBOX(NVEC) = IXF
IYFBOX(NVEC) = IYF
END IF
10 CONTINUE
IF (NVEC.EQ.0) RETURN
C
magupd = 0
CALL XDLF_IMAGE_VECTS(IVHIMG,BOX_VEC,NVEC,IXSBOX,IYSBOX,
$ IXFBOX,IYFBOX,ICOLR,BOX_IOVL,MAGUPD,IERR)
RETURN
END
c
SUBROUTINE DSPCEL(XMEASPT, NORDER, DISTANCE, THETA, WAVELENGTH,
$ SPACNG)
C ==============================================================
c
c Calculate lattice spacing from two points
c
c Input:
c xmeaspt(2,2) pixel values of two points
c xmeaspt(i,j): i=1 Yms, i=2 Xms, j=1,2 for 2 points
c norder number of diffraction orders
c distance detector distance (mm)
c theta detector angle (degrees)
c wavelength wavelength (A)
c
c Output:
c spacng lattice spacing in A
C
IMPLICIT NONE
C ..
C .. External Subroutines ..
EXTERNAL MATVEC,VADD,VNORM
C ..
C .. External Functions ..
REAL DOT
EXTERNAL DOT
C
INTEGER NORDER
REAL XMEASPT(2,2)
REAL DISTANCE, THETA, WAVELENGTH, SPACNG
C
REAL VDCO(3), S0(3), DD(3,3), DN(3), D(3), S1(3), S(3,2), DS
INTEGER I, J
C
c Source
S0(1) = 0.0
S0(2) = 0.0
S0(3) = 1.0
c Detector rotation
CALL DDMAT(DISTANCE, THETA, DD, DN)
C
DO 10, J=1,2
c Convert pixel to mm
C CALL PXTOMM(XMEASPT(1,J), XMEASPT(2,J),
CALL PXTOMM(XMEASPT(2,J), XMEASPT(1,J),
$ VDCO(1), VDCO(2))
VDCO(3) = 1.0
C
c Diffracted beam vector
CALL MATVEC(S1,DD,VDCO)
CALL VNORM(S1,S1,I)
C Diffraction vector s = s0 + s1
CALL VADD(S(1,J),S0,S1)
C Scale by wavelength, to get vector in a**-1
CALL VMSCAL(S(1,J),S(1,J),1./WAVELENGTH)
10 CONTINUE
C
CALL VSUB(D,S(1,1),S(1,2))
DS = DOT(D,D)
C
IF (DS . GT. 0.0000001) THEN
SPACNG = FLOAT(NORDER) / SQRT(DS)
ELSE
SPACNG = 0.0
ENDIF
C
RETURN
END
SUBROUTINE DSPCIRC(XC,YC,RC,ICOLR)
C ==================================
C
C---- Draw a circle radius RC mm centred on image coordinates XC,YC mm, colour
C specified by ICOLR
C ICOLR = 1 Red
C = 2 Yellow
C = 3 Green
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C
C .. Scalar Arguments ..
REAL XC,YC,RC
INTEGER ICOLR
C
C .. Local Scalars ..
INTEGER I,NSTEP,MAGUPD,IX,IY,IERR
REAL DTOR,PHI,DPHI,PI,XPIX,YPIX,RCPIX,XCPIX,YCPIX,VECLEN
C
C .. Local Arrays ..
INTEGER IXS(4000),IYS(4000),IXF(4000),IYF(4000)
C ..
C .. External Subroutines ..
EXTERNAL XDLF_IMAGE_VECTS
C ..
C .. Common blocks ..
C
C include '../inc/dsplyc.f'
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
C
DATA VECLEN /0.5/
IF (RC.LE.0.0) RETURN
PI = 4.0*ATAN(1.0)
DTOR = PI/180.0
C
C---- Set vector length to 0.5mm, but we always want at least 12 vectors
C
5 NSTEP = 2*PI*RC/VECLEN
IF(NSTEP.LT.12)THEN
VECLEN = VECLEN / 2
GOTO 5
ENDIF
IF (NSTEP.LT.2) RETURN
IF (NSTEP.GT.3999) NSTEP = 3999
DPHI = 360.0/NSTEP*DTOR
PHI = 0.0
C
C---- Convert to image pixels
C
RCPIX = RC/RAST
XCPIX = XC/RAST
YCPIX = YC/RAST
DO 10 I = 1,NSTEP+1
IXS(I) = NINT(XCPIX + RCPIX*COS(PHI))
IYS(I) = NINT(YCPIX + RCPIX*SIN(PHI))
PHI = PHI + DPHI
IF (I.EQ.1) GOTO 10
IXF(I-1) = IXS(I)
IYF(I-1) = IYS(I)
10 CONTINUE
C
C---- Draw circle as a series of vectors
C
MAGUPD = 0
CALL XDLF_IMAGE_VECTS(IVHIMG,CIRC_VEC,NSTEP,IXS,IYS,
$ IXF,IYF,ICOLR,CIRC_IOVL,MAGUPD,IERR)
RETURN
END
SUBROUTINE DSPCRS(IX, IY, N, ICOLR,ISIZE)
C =========================================
c
c Draw crosses at N points (display pixels) IX, IY, colour icolr, size ISIZE
c ICOLR = 1 Red
C = 2 Yellow
C = 3 Green
c
IMPLICIT NONE
C
INTEGER N
INTEGER IX(N), IY(N)
INTEGER ICOLR,ISIZE
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER IERR,ICROSS_SYMB
SAVE
C
ICROSS_SYMB = ISIZE
IF (ICROSS_SYMB.LE.0) ICROSS_SYMB = 1
IF (ICROSS_SYMB.GT.10) ICROSS_SYMB = 10
C
IF (N .GT. 1) THEN
CALL XDLF_IMAGE_SYMBOLS(IVHIMG,N,IX,IY,
$ ICROSS_SYMB,ICOLR,CROSS_IOVL,1,IERR)
ELSE IF (N .EQ. 1) THEN
CALL XDLF_IMAGE_SYMBOL(IVHIMG,IX(1),IY(1),
$ ICROSS_SYMB,ICOLR,CROSS_IOVL,IERR)
ENDIF
C
RETURN
END
c
SUBROUTINE DSPDEL
c =================
c
c Close down display
c
IMPLICIT NONE
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
c
INTEGER IERR
SAVE
C
WINOPEN = .FALSE.
IF (DISP_MENU) THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHMEN,IERR)
DISP_MENU = .FALSE.
END IF
IF (DISP_PAR) THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHPAR,IERR)
DISP_PAR = .FALSE.
END IF
IF (DISP_NOT) THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHNOT,IERR)
DISP_NOT = .FALSE.
END IF
IF (DISP_IMG) THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHIMG,IERR)
DISP_IMG = .FALSE.
END IF
IF (DISP_IO)THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHIO,IERR)
DISP_IO = .FALSE.
END IF
IF (DISP_IO2)THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHIO2,IERR)
DISP_IO2 = .FALSE.
END IF
IF (DISP_IO3)THEN
CALL XDLF_DELETE_VIEW_OBJECT(IVHIO3,IERR)
DISP_IO3 = .FALSE.
END IF
IF (BLANK) CALL XDLF_DELETE_VIEW_OBJECT(IVHBLANK,IERR)
CALL XDLF_DELETE_VIEW_OBJECT(IVHBAS,IERR)
IF (IERR .NE. 0) THEN
CALL MXDERR('DSPDEL: FAILED TO QUIT',1,IERR)
ENDIF
CALL XDLF_FLUSH_EVENTS(IERR)
CAL CALL XDLF_DELETE_VIEW_OBJECT(IVHPMN,IERR)
IF (IERR .NE. 0) THEN
CALL MXDERR('DSPDEL: FAILED TO QUIT',2,IERR)
ENDIF
CALL XDLF_FLUSH_EVENTS(IERR)
RETURN
END
SUBROUTINE DSPEDT(LHELP)
IMPLICIT NONE
C
C---- Write instructions on how to edit spots list from
C IMSTILLS spots list.
C
C ..
C .. Scalar Arguments ..
LOGICAL LHELP
C ..
C .. Local Scalars ..
INTEGER IXW,IYW,LINELEN,NUMLIN,IBUTTON,IXP,IYP,L,I
CHARACTER LINE*80
C ..
C .. External Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C ..
C .. External Subroutines ..
EXTERNAL MXDCIO,MXDWIO,XDLF_POPUP_NOTICE
IXW = 200
IYW = 200
LINELEN = 52
NUMLIN = 16
CALL XDLF_FLUSH_EVENTS(I)
C
C Create IO window
C
IF (.NOT.LHELP) RETURN
CALL MXDCIO(0,LINELEN, NUMLIN, IXW,IYW)
C
WRITE (LINE, 6000)
6000 FORMAT(1X,'Clicking on a spot in the displayed spot list will')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6002)
6002 FORMAT (1X,'result in the intensity for that spot being set to')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6004)
6004 FORMAT (1X,'the negative of its current value. Negative')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6006)
6006 FORMAT (1X, 'intensities will be rejected by the THRESHOLD')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6008)
6008 FORMAT (1X, 'set in REFIX. Note then clicking on a rejected')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6010)
6010 FORMAT (1X, 'spot will make its intensity positive again.')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6012)
6012 FORMAT (1X, 'Hit the "End edit" menu item to finish the edit')
CALL MXDWIO(LINE, 2)
END
SUBROUTINE DSPENDEDT
IMPLICIT NONE
C
C---- Editing of spot list finished, allow edited file to be saved
C ..
C .. Scalar Arguments ..
C
C ..
C .. Local Scalars ..
INTEGER IXW,IYW,LINELEN,NUMLIN,IBUTTON,IXP,IYP,L,ISTAT,IFLAG
CHARACTER LINE*80,STR*100,SPTNAM*100,NSPTNAM*100
C ..
C .. External Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C ..
C .. External Subroutines ..
EXTERNAL MXDCIO,MXDWIO,XDLF_POPUP_NOTICE
IXW = 200
IYW = 200
LINELEN = 52
NUMLIN = 16
C
C Create IO window
C
LINE = 'Do you want to save the edited spot list ?'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,XDLSTR(' '),0,
$ XDLSTR('Yes'),3,XDLSTR('No'),2,3,0,IBUTTON)
IF (IBUTTON.EQ.1) THEN
IFLAG = 0
CALL WSPOT(IFLAG)
END IF
END
C== DSPFND ==
SUBROUTINE DSPFND(LHELP,LINE,BOXOPEN2)
IMPLICIT NONE
LOGICAL LHELP,BOXOPEN2
CHARACTER LINE*80
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- Give information on spot finding
C
INTEGER IXW,IYW,LINELEN,NUMLIN,IXP,IYP,L,IBUTTON,I
CHARACTER STR1*7,STR2*1,STR3*1,STR4*7,LLINE*80
LOGICAL NULINE
C ..
C .. External Subroutines ..
EXTERNAL XDLF_POPUP_NOTICE,MXDCIO,MXDWIO
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C
IF (.NOT.LHELP) RETURN
C
IXW = 200
IYW = 200
LINELEN = 56
NUMLIN = 50
NULINE = .TRUE.
IF (RADX) THEN
STR1 = 'Yoffset'
STR2 = 'Y'
STR3 = 'X'
STR4 = 'Xoffset'
ELSE IF (RADY) THEN
STR1 = 'Xoffset'
STR2 = 'X'
STR3 = 'Y'
STR4 = 'Yoffset'
END IF
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXW,IYW)
BOXOPEN2 = .TRUE.
LLINE = ' '
WRITE (IOLINE, 6020) STR1,STR2,STR3,STR4
6020 FORMAT('Find spots for autoindexing. Parameters determining',/,
+ 'the spot finding are listed under *SPOT SEARCH* ',/,
+ 'in the "processing params" menu. Pixels with values',/,
+ 'greater than "Threshold" sds above background are ',/,
+ 'considered to belong to spots. The program will set ',/,
+ 'a suitable threshold automatically, but for ',/,
+ '"difficult" images it can be set manually. ',/,
+ 'The spot search will be between Rmin and Rmax mm of',/,
+ 'the direct beam position.',/,
+ 'The median spot size (in X and Y) will be determined',/,
+ 'and Xmin,Xmax,Ymin,Ymax are the limits on the spot',/,
+ 'sizes as a function of this median size. Reduce ',/,
+ 'the max values if spots are not well resolved.',/,
+ '"Min no of pix" is the minimum number of pixels in',/,
+ 'in a spot. Use the "Min I/sig(I)" parameter to test',/,
+ 'the effect of changing the intensity threshold ',/,
+ 'applied in the actual autoindexing.',/,/,
+ 'A radial background will be determined within the ',/,
+ 'area outlined in red. You should ensure that this',/,
+ 'strip does not include the backstop shadow. If it',/,
+ 'does, use the ',A,' parameter to move it.',/,/,
+ 'The length of the strip is determined by Rmin,Rmax.',/,
+ 'To determine the background on the other side of ',/,
+ 'the direct beam, negate the sign of Rmin or Rmax.',/,/,
+ 'To determine the background along ',A,
+ ' rather than ',A,/,
+ 'enter any value (including zero) for ',A)
CALL WINDIO(NULINE)
C
C---- Check for continuation
C
20 LLINE = ' '
WRITE (LLINE, 6018)
6018 FORMAT ( 'Do you wish to continue ? (Y):')
CALL MXDWIO(LLINE, 1)
CALL MXDRIO(LINE)
RETURN
END
C
C
SUBROUTINE DSPIMG(IMAGE,NXPIX,NYPIX,NEWSCL,STORIMAG)
C =======================================================
C
c Display image from array IMAGE
c
c newscl = .true. if new scale factor, reset after display
C
IMPLICIT NONE
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER NXPIX,NYPIX
INTEGER*2 IMAGE(NXPIX*NYPIX)
LOGICAL NEWSCL
CHARACTER STORIMAG*200
C
C
INTEGER K
SAVE
C
C
C---- See if this image is currently being displayed
C
IF (CDSPTL.EQ.STORIMAG) RETURN
C
K = IMGHI - IMGLOW
IF (K .EQ. 0) THEN
C INVALID SCALING RANGE, TRY TO RESCALE
CAL CALL ERROUT('DSPIMG: rescaling image',0,0)
CALL DSPSCL(IMAGE,NXPIX,NYPIX)
NEWSCL = .TRUE.
K = IMGHI - IMGLOW
IF (K .EQ. 0) THEN
C STILL INVALID SCALING RANGE, GIVE UP
CAL CALL ERROUT('DSPIMG: rescaling image',0,0)
RETURN
C ======
C
ENDIF
ENDIF
C
C---- Display image
C
CALL MXDBSY(0,'Making image')
CALL MXDBSY(-1, ' ')
C
CALL MXDIMG(NEWSCL,
$ IMAGE,NXPIX,NYPIX,
$ MAXDEN,IMGLOW,IMGHI,CDSPTL)
C
JDSPWD = ABS(JDSPWD)
NEWSCL = .FALSE.
STORIMAG = CDSPTL
C
RETURN
END
C
C
C
SUBROUTINE DSPINI(TITLE, LACTIV, NXPIX, NYPIX)
C ===============================================
C
C Initialize image display
C
C Input:
C TITLE banner title for window
C LACTIV = .true. if active window, .false. if not (auto-display)
C NXPIX, NYPIX image size
C
IMPLICIT NONE
C
CHARACTER*(*) TITLE
LOGICAL LACTIV
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
c
c Size of image
INTEGER NXPIX, NYPIX
C
LOGICAL FIRST
DATA FIRST /.TRUE./
SAVE
C
C INITIALIZE COMMON VARIABLES
IF (FIRST) THEN
IMGLOW = 0
IMGHI = 0
JDSPWD = -1
MAXDEN = 65535
LDSPSG = .TRUE.
FIRST = .FALSE.
ENDIF
C
CALL DSPTTL(TITLE,LACTIV)
C
CALL MXDINI(NXPIX, NYPIX)
C
RETURN
END
C
C
C
c
SUBROUTINE DSPPCK(IX1, IY1, MS, NXPIX, NYPIX, IEXTYZ, IX,IY)
C ============================================================
C
c Display figure field in picked area
c
c Input:
c IX1, IY1 picked point
c ms(NYPIX,NXPIX) image
c iextyz(2) size of pick box
c ix,iy position for window
c
IMPLICIT NONE
C
INTEGER IY1,IX1,NYPIX,NXPIX,IEXTYZ(2),IX,IY
C
INTEGER*2 MS(NYPIX,NXPIX)
C
INTEGER IWHERE(4)
C
IWHERE(1) = IY1
IWHERE(2) = IX1
IWHERE(3) = IEXTYZ(1)
IWHERE(4) = IEXTYZ(2)
C
CALL PCKLIS(MS, NXPIX, NYPIX, IWHERE, IX,IY)
C
RETURN
END
C== DSPPRD ==
C
SUBROUTINE DSPPRD(NDISP,MODE)
C =============================
C
IMPLICIT NONE
C Display predicted reflections for this image, returns the number of
C spots displayed (NDISP).
C Display pixel coordinates are stored in arrays IX,IY in /GENDATA/
C ..
C .. Scalar Arguments ..
INTEGER NDISP,MODE
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Local Scalars ..
INTEGER I, KD,IXPIX(1),IYPIX(1),ISTAT,IXF,IYF,IMAX,IXSIZE,IYSIZE,
+ IBSIZE,NPART,NREJ,KDS,IR,IM,ICSIZE,ICOLFULL,ICOLPART,
+ ICOLOVERL,ICOLWIDE,IR1,IR2
REAL XC,YC,XCAL,YCAL
C ..
C .. Local Arrays ..
INTEGER IBUF(10)
C ..
C .. External Subroutines ..
EXTERNAL DSPBOX,MMTOPX,CNVPIX,DSPCRS,MXDBSY2
C ..
C .. Common blocks ..
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
SAVE
C ..
C .. Equivalences ..
C
C
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IF(NEWPREF)IR2 = 30*IPAD + 30
C
C---- Set up colours
C
ICOLFULL = 5
ICOLPART = 2
ICOLOVERL = 1
ICOLWIDE = 3
CALL MXDBSY2(0,'Blue: fulls, Yellow: partials, Red: overlaps',
+ 'Green: too wide in phi')
C
IMAX = NSPOT
IF (IMAX.EQ.0) IMAX = TOSPT
C
C---- Special case when examining image after integration, must use TOSPT
C
IF (MODE.EQ.5) IMAX = TOSPT
C
IF (IMAX.EQ.0) THEN
NDISP = 0
RETURN
END IF
C
KD = 0
C
C---- Work out the box size...make this the same size as the peak.
C Note the size passed is the "half-height" of the box
C
IXSIZE = IRAS(1) - 2*IRAS(4)
IYSIZE = IRAS(2) - 2*IRAS(5)
IF (IXSIZE.EQ.0) IXSIZE = 5
IF (IYSIZE.EQ.0) IYSIZE = 5
C
C---- Loop over reflections in generate file, find fulls first
C
DO 10 I = 1,IMAX
IR = IRG(I)
IM = IMG(I)
XC = XG(I)
YC = YG(I)
IF ((IR.NE.0).OR.(IM.NE.0)) GOTO 10
C
C---- Convert generate file coords (10 micron units) to 10 micron coords in
C image coordinate frame (XCAL,YCAL).
C
C
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert XCAL,YCAL to image pixels
C
IXPIX(1) = NINT(FACT*XCAL)
IYPIX(1) = NINT(FACT*YCAL)
KD = KD + 1
IX(KD) = IXPIX(1)
IY(KD) = IYPIX(1)
IREC(KD) = I
C
10 CONTINUE
C
C---- Display fulls
C
IF (KD .GT. 0) CALL DSPBOX(IX(1),IY(1),KD,ICOLFULL,IXSIZE,IYSIZE)
KDS = KD
C
C---- Loop over reflections in generate file, find partials
C
DO 20 I = 1,IMAX
IR = IRG(I)
IM = IMG(I)
XC = XG(I)
YC = YG(I)
IF ((IR.LT.IR1).OR.(IM.EQ.0)) GOTO 20
C
C---- Convert coords to pixels
C
C
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert XCAL,YCAL to pixels
C
IXPIX(1) = NINT(FACT*XCAL)
IYPIX(1) = NINT(FACT*YCAL)
KD = KD + 1
IX(KD) = IXPIX(1)
IY(KD) = IYPIX(1)
IREC(KD) = I
C
20 CONTINUE
C
C---- Display partials
C
NPART = KD -KDS
IF (NPART .GT. 0)
+ CALL DSPBOX(IX(KDS+1), IY(KDS+1), NPART,ICOLPART,IXSIZE,IYSIZE)
KDS = KD
C
C---- Loop over reflections in generate file, find spatial overlaps
C
DO 30 I = 1,IMAX
IR = IRG(I)
IM = IMG(I)
XC = XG(I)
YC = YG(I)
C
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot
C = 3 Cut off at both ends
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Within cusp, but part of rlp still intersects sphere
C
IF (IR.NE.2) GOTO 30
C
C---- Convert coords to pixels
C
C
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert XCAL,YCAL to pixels
C
IXPIX(1) = NINT(FACT*XCAL)
IYPIX(1) = NINT(FACT*YCAL)
KD = KD + 1
IX(KD) = IXPIX(1)
IY(KD) = IYPIX(1)
IREC(KD) = I
C
30 CONTINUE
C
C---- Display rejects
C
NREJ = KD - KDS
IF (NREJ .GT. 0)
+ CALL DSPBOX(IX(KDS+1),IY(KDS+1),NREJ,ICOLOVERL,IXSIZE,IYSIZE)
C
KDS = KD
C
C---- Loop over reflections in generate file, find reflections too wide
C
DO 40 I = 1,IMAX
IR = IRG(I)
IM = IMG(I)
XC = XG(I)
YC = YG(I)
C
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot
C = 3 Cut off at both ends
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Within cusp, but part of rlp still intersects sphere
C
IF ((IR.EQ.0).OR.(IR.EQ.1).OR.(IR.EQ.2).OR.(IR.EQ.4).OR.
+ (IR.GT.10)) GOTO 40
C
C---- Convert coords to pixels
C
C
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert XCAL,YCAL to pixels
C
IXPIX(1) = NINT(FACT*XCAL)
IYPIX(1) = NINT(FACT*YCAL)
KD = KD + 1
IX(KD) = IXPIX(1)
IY(KD) = IYPIX(1)
IREC(KD) = I
C
40 CONTINUE
C
C---- Display reflections too wide
C
NREJ = KD - KDS
IF (NREJ .GT. 0)
+ CALL DSPBOX(IX(KDS+1),IY(KDS+1),NREJ,ICOLWIDE,IXSIZE,IYSIZE)
C
NDISP = KD
C
C---- Display a cross at direct beam position
C
C
C---- Convert coords to pixels
C
C
XC = 0
YC = 0
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert XCAL,YCAL to pixels
C
IXPIX(1) = NINT(FACT*XCAL)
IYPIX(1) = NINT(FACT*YCAL)
C
C---- Check within image
C
CALL CNVPIX(IXPIX(1),IYPIX(1), ISTAT)
IF (ISTAT .EQ. 0) THEN
ICSIZE = 5
IF (NZOOM.GT.0) ICSIZE = 8
CALL DSPCRS(IXPIX,IYPIX,1,1,ICSIZE)
END IF
RETURN
END
C== DSPRSD ==
C
SUBROUTINE DSPRSD
C =================
C
IMPLICIT NONE
C Display residual vectors indicating positional errors
C Vectors are stored in ITXVECT in /spvect/
C ..
C .. Scalar Arguments ..
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Local Scalars ..
INTEGER I,J,IX,IY,IDELX,IDELY,IPT,IXF,IYF,IERR,
+ MAGUPD,IXE,IYE,INTEN,NVEC,IEND
C ..
C .. Local Arrays ..
INTEGER IXSRV(NREFLS),IYSRV(NREFLS),IXFRV(NREFLS),IYFRV(NREFLS)
C ..
C .. External Subroutines ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spvect.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spvect.h
C---- START of include file spvect.h
C
C
C .. Scalars in common block /SPVECT/ ..
INTEGER NRESID,IDVECT
C
C
C .. Arrays in Common Block /SPVECT/ ..
INTEGER IXSBOX,IYSBOX,IXFBOX,IYFBOX
INTEGER*2 ITXVECT
C ..
C .. Common Block /SPVECT/ ..
COMMON /SPVECT/ IXSBOX(4*NREFLS),IYSBOX(4*NREFLS),
+ IXFBOX(4*NREFLS),IYFBOX(4*NREFLS),
+ NRESID,IDVECT,ITXVECT(NREFLS*5)
C ..
C
C
C&&*&& end_include ../inc/spvect.f
SAVE
C ..
C .. Equivalences ..
C
MAGUPD = 1
NVEC = 0
C
C---- Loop over stored reflections
C
DO 10 I = 1,NRESID
IPT = (I-1)*5
IX = ITXVECT(IPT+1)
IY = ITXVECT(IPT+2)
IDELX = ITXVECT(IPT+3)
IDELY = ITXVECT(IPT+4)
INTEN = 100*ITXVECT(IPT+5)
IF (INTEN.LT.ITHRESH) GOTO 10
NVEC = NVEC + 1
IXSRV(NVEC) = IX
IYSRV(NVEC) = IY
IEND = IX + IDELX*IRSCAL
IF (IEND.LT.1) THEN
IEND = 1
ELSE IF (IEND.GT.NXDPX) THEN
IEND = NXDPX
END IF
IXFRV(NVEC) = IEND
IEND = IY + IDELY*IRSCAL
IF (IEND.LT.1) THEN
IEND = 1
ELSE IF (IEND.GT.NYDPX) THEN
IEND = NYDPX
END IF
IYFRV(NVEC) = IEND
10 CONTINUE
C
IF (NVEC.EQ.0) RETURN
CALL XDLF_IMAGE_VECTS(IVHIMG,IRV_VEC,NVEC,IXSRV,IYSRV,
+ IXFRV,IYFRV,IRV_COL,IRV_OVL,MAGUPD,IERR)
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6000) IERR
IF (ONLINE) WRITE(ITOUT,FMT=6000) IERR
6000 FORMAT(1X,'*** xdlf_film_image_vect error ',I5)
END IF
RETURN
END
C
C
C
C
C
SUBROUTINE DSPSCL(IMAGE,NXPIX,NYPIX)
C ====================================
C
C Look through current image, get minimum & maximum & average values
C Put these into IMGLOW, IMGHI in common
C Ignore corners (NCORNR pixels), and edges (NEDGE pixels) where there
C may be problems
C Also exclude zero
C
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
INTEGER NXPIX, NYPIX
INTEGER*2 IMAGE(NXPIX*NYPIX)
C
C
INTEGER I, J, K, I1, I2, NPT, IUMAX, IVMAX
INTEGER OUTLUN
REAL AVERAG
INTEGER INTPXL
EXTERNAL INTPXL
C
C---- ** DANGER *** blows up if NCORNR set to NEDGE !!
C
C
SAVE
IMGLOW = 1000000
IMGHI = -IMGLOW
AVERAG = 0.0
NPT = 0
NTOT = NXPIX*NYPIX
C
DO 10 I = 1,NTOT
K = INTPXL(IMAGE(I))
IF (K .NE. 0) THEN
IMGLOW = MIN(IMGLOW, K)
IF (K .GT. IMGHI) THEN
IMGHI = K
ENDIF
AVERAG = AVERAG + K
NPT = NPT + 1
ENDIF
10 CONTINUE
C
IF (NPT .GT. 0) THEN
AVERAG = AVERAG / FLOAT(NPT)
ELSE
WRITE (IOUT, '(A)') ' *** No points in average ***'
IF (ONLINE) WRITE (ITOUT, '(A)')
+ ' *** No points in average ***'
AVERAG = 1000.0
ENDIF
C
c.c WRITE (OUTLUN, 6010) IMGLOW, IMGHI, IUMAX, IVMAX, AVERAG
6010 FORMAT(' Image: minimum = ',I6,', maximum = ',I6,' at',2I5,
* ', average = ',F8.1/)
C
C Reset maximum to minimum + 4 * (average - minimum)
IMGHI = IMGLOW + 4 * (AVERAG - IMGLOW)
C
RETURN
END
C== DSPSEL ==
SUBROUTINE DSPSEL(LINE,NPROC)
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER NPROC
CHARACTER LINE*80
C
C
C---- Allow selection of images for spots
C
C ..
C .. Local Scalars ..
INTEGER IXW,IYW,LINELEN,NUMLIN,IXP,IYP,L,IBUTTON,I,J,NCH,NSPTIMG
CHARACTER STR1*7,STR2*1,STR3*1,STR4*7,STR*80
C ..
C .. External Subroutines ..
EXTERNAL XDLF_POPUP_NOTICE,MXDCIO,MXDWIO
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C ..
C .. Common blocks ..
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C
C
IXW = 200
IYW = 200
LINELEN = 80
NUMLIN = 19
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXW,IYW)
LINE = ' '
WRITE (LINE, 6008)
6008 FORMAT (1X,'This allows selection of images for autoindexing')
CALL MXDWIO(LINE, 2)
C
C---- Get list of images wih spots found on them
C
STR = ' '
J = 0
NPROC = 0
DO 10 I = 1,NIMAG
NSPTIMG = IENDIMG(I) - ISTIMG(I)
IF (NSPTIMG.GT.0) NSPTIMG = NSPTIMG + 1
LINE = ' '
WRITE(LINE,6012) I, NOIMG(I), NSPTIMG
6012 FORMAT(1X,'Slot',I3,' image number',I4, ' number of spots',
+ I5)
CALL MXDWIO(LINE, 2)
IF (SPOTFND(I)) THEN
NPROC = NPROC + 1
WRITE(STR4,6010) I
CALL STRIPSTR(STR4,NCH)
J = LENSTR(STR)
IF (J.EQ.0) THEN
STR = STR4(1:NCH)
ELSE
STR = STR(1:J)//','//STR4(1:NCH)
END IF
J = LENSTR(STR)
END IF
10 CONTINUE
6010 FORMAT(I3)
LINE = ' '
WRITE (LINE, 6000) NIMAG,NPROC
6000 FORMAT(1X,'A total of',I3,' images have been read',
+ ' of which',I3,' have been processed')
CALL MXDWIO(LINE, 2)
LINE = ' '
IF (NPROC.GT.0) THEN
WRITE (LINE, 6002)
6002 FORMAT (1X, 'The slot numbers of processed images are:')
CALL MXDWIO(LINE, 2)
LINE = ' '
IF (J.GT.0) WRITE (LINE, 6004) STR(1:J)
6004 FORMAT (1X,A)
CALL MXDWIO(LINE, 2)
LINE = ' '
END IF
WRITE (LINE, 6006)
6006 FORMAT (1X,'Give the slot (NOT image) numbers to be selected ',
+ '(default use all images)')
CALL MXDWIO(LINE, 2)
C
C---- Read input line
C
CALL MXDRIO(LINE)
CALL MXDCIO(1,0,0,0,0)
RETURN
END
SUBROUTINE DSPSPT(MODE)
C =======================
C
IMPLICIT NONE
C
C---- Display list of spots found by spot-search routines.
C Coordinates are converted into display pixels before display.
C
C MODE =1 Display only the last spot (used for manual addition
C of spts)
C NSPTD... Number of spots displayed. now in /spots2/
C ..
C .. Scalar Arguments ..
C
INTEGER MODE
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Local Scalars ..
INTEGER I,IXPIX,IYPIX,ICSIZE,ISTAT,NSPPLUS,NSPNEG,IST,
+ IEND,IRAT
C ..
C .. Local Arrays ..
C INTEGER
C ..
C .. External Subroutines ..
EXTERNAL CNVPIX,DSPCRS,DSPXCRS
C ..
C .. Common blocks ..
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
SAVE
C ..
C .. Equivalences ..
C
C
C---- Loop over reflections in Spots list
C
IF (NSPT.EQ.0) RETURN
C
ICSIZE = 5
IF (NZOOM.GT.0) ICSIZE = 8
IF (MODE.EQ.0) THEN
NSPTD = 0
END IF
IST = 1
IEND = NSPT
IF (NIMAG.GT.1) THEN
IST = ISTIMG(NIMAG)
IEND = IENDIMG(NIMAG)
END IF
C
C---- Trap case where spots have not yet been found for this image
C
IF (IEND.EQ.0) RETURN
C
C---- If MODE=1, only plot the last spot found
C
IF (MODE.EQ.1) IST = IEND
C
DO 10 I = IST,IEND
C
C---- Test threshold, plot only spots with intensity above threshold
C but plot -ve intensity spots also (those rejected with edit spots)
C
IRAT = 0
IF (ISDSPT(I).GT.0) IRAT = ISPT(I)/ISDSPT(I)
IF ((IRAT.LT.ITHRESH).AND.(ISPT(I).GT.0)) GOTO 10
C
C---- Convert mm cordinates to pixels
C
IXPIX = NINT(XSPT(I)/RAST)
IYPIX = NINT(YSPT(I)*YSCAL/RAST)
C
C---- Check within image
C
CALL CNVPIX(IXPIX,IYPIX, ISTAT)
IF (ISTAT .EQ. 0) THEN
NSPTD = NSPTD + 1
IXSPT(NSPTD) = IXPIX
IYSPT(NSPTD) = IYPIX
INDX(NSPTD) = I
ENDIF
10 CONTINUE
C
C---- Display spots
C
IF (NSPTD .GT. 0) THEN
IF (MODE.EQ.0) THEN
CALL DSPCRS(IXSPT(1),IYSPT(1),NSPTD,1,ICSIZE)
ELSE
CALL DSPCRS(IXSPT(NSPTD),IYSPT(NSPTD),1,1,ICSIZE)
END IF
END IF
C
C---- if only plotting latest spot, return now
C
IF (MODE.EQ.1) RETURN
NSPPLUS = NSPTD
C
C---- Now display rejected spots (intensity is -ve)
C
DO 20 I = IST,IEND
C
C---- Test threshold, plot only spots with intensity above threshold
C
IF (ISPT(I).GE.0) GOTO 20
C
C---- Convert mm cordinates to pixels
C
IXPIX = NINT(XSPT(I)/RAST)
IYPIX = NINT(YSPT(I)/RAST)
C
C---- Check within image
C
CALL CNVPIX(IXPIX,IYPIX, ISTAT)
IF (ISTAT .EQ. 0) THEN
NSPTD = NSPTD + 1
IXSPT(NSPTD) = IXPIX
IYSPT(NSPTD) = IYPIX
INDX(NSPTD) = I
ENDIF
20 CONTINUE
C
NSPNEG = NSPTD - NSPPLUS
C
C---- Display spots
C
IF (NSPNEG .GT. 0) CALL DSPXCRS(IXSPT(NSPPLUS+1),IYSPT(NSPPLUS+1),
+ NSPNEG,1,ICSIZE)
RETURN
END
C
C
C
SUBROUTINE DSPTTL(TITLE, LACTIV)
C ================================
C
C Set banner title for image display, and set flag whether image
C will be active (ie may be zoomed), or not (LACTIV .true. or .false.)
C
C only takes effect on next creation of image window
C
CHARACTER*(*) TITLE
LOGICAL LACTIV
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
SAVE
C
C CDSPTL = TITLE
C
IF (LACTIV) THEN
C Set flag = +/-1 (positive if window already opened)
JDSPWD = SIGN( +1, JDSPWD)
ELSE
C Inactive, set flag = +/-2 (positive if window already opened)
JDSPWD = SIGN( +2, JDSPWD)
ENDIF
C
RETURN
END
SUBROUTINE DSPXCRS(IX, IY, N, ICOLR,ISIZE)
C ==========================================
C
C Draw X crosses at N points (pixels) IX, IY, colour icolr, size ISIZE
C
C---- Uses SYMBOL drawing routines
C
C ICOLR = 1 Red
C = 2 Yellow
C = 3 Green
C = 4 Cyan
C = 5 Blue
C = 6 Magenta
IMPLICIT NONE
C
INTEGER N
INTEGER IX(N), IY(N)
INTEGER ICOLR,ISIZE
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER IERR,ICROSS_SYMB
SAVE
C
ICROSS_SYMB = ISIZE + 10
IF (ICROSS_SYMB.LE.10) ICROSS_SYMB = 11
IF (ICROSS_SYMB.GT.20) ICROSS_SYMB = 20
C
IF (N .GT. 1) THEN
CALL XDLF_IMAGE_SYMBOLS(IVHIMG,N,IX,IY,
$ ICROSS_SYMB,ICOLR,XCROSS_IOVL,1,IERR)
ELSE IF (N .EQ. 1) THEN
CALL XDLF_IMAGE_SYMBOL(IVHIMG,IX(1),IY(1),
$ ICROSS_SYMB,ICOLR,XCROSS_IOVL,IERR)
ENDIF
C
RETURN
END
C== DSTAR ==
C
SUBROUTINE DSTAR(IP,IQ,IR,KT,KH,DELEPS1,DELEPS2,PHI,PHIW,DRATIO)
C ================================================================
C
C---- Routine tests spot IP,IQ,IR with lab coord of X12,Y12,Z12
C (dimensionless rlu's)
C KT = -4 Spot is entirely within cusp
C = -3 Spot is within cusp, but part of rlp touches Ewald
C sphere so spot will be observed
C = -2 Spot has DSTAR .GT. DSTARPLUS (DSTPL)
C = -1 Spot not recorded
C = 0 Good spot
C
C KH = 0 Full spot
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C = 3 Extends over too many images (more than NWMAX
C which can be set by keyword MAXWIDTH)
C
C DELEPS1 Fraction of spot remaining to pass through Ewald
C sphere at start of oscillation.
C DELEPS2 Fraction of spot that has already passed through
C Ewald sphere at end of oscillation.
C PHI Phi value when rlp is on the Ewald sphere
C PHIW Reflection width
C
C Passed through common /REEKE/
C X1,Y1,Z1 - Lab coord at PHI1 (dimensionless rlu's)
C X2,Y2,Z2 - Lab coord at PHI2 (dimensionless rlu's)
C
C
C debug(38) this s/r
C
C .. Scalar Arguments ..
REAL DELEPS1,DELEPS2,DRATIO
INTEGER IP,IQ,IR,KH,KT
C ..
C .. Local Scalars ..
REAL ADEL1,ADEL2,CSIMIN2,DEL1,DEL2,DIST2,DIVERG,DST4,ESYNH,ESYNV,
+ RSPOT,X1S,Y1S,Y2S,YMID,YMS,Z1S,PHIC,DTOR,XE1,XE3,CEA,CEB,
+ CEC,CEABSQ,ARG1,T1,T2,T3,RLORF,OSCRNG,PHIS,
+ PHIE,PHIA,PHIB,RMIDPHI,DIFF1,DIFF2
INTEGER ISY,ICOUNT,I,ISTART,IEND,IWIDTH
C ..
C .. Local Arrays ..
REAL E1(3),E2(3),E3(3),XRLP(3),SO(3),XRLPE(3),PHICR(3,3),E3SO(3)
C ..
C .. External Functions ..
REAL DOT
EXTERNAL DOT
C ..
C .. External Subroutines ..
EXTERNAL CROSS,UNIT,SURMP,MATVEC
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,NINT,SIGN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C ..
SAVE
DATA ICOUNT/0/
C
C
DTOR = 4.0*ATAN(1.0)/180.0
KH = 0
KT = 0
DELEPS1 = 0.0
DELEPS2 = 0.0
X1S = X1*X1
Y1S = Y1*Y1
Y2S = Y2*Y2
Z1S = Z1*Z1
XYS = X1S + Y1S
DSTAR2 = XYS + Z1S
C
C---- Calculate the phi value for this rlp to be on the Ewald sphere
C This code based on MADNES Phase 3 notes, p62-64.
C First set up a set of orthogonal axes:
C E3 along rotation axis, ie 0,0,1
C E2 perp to E3 and rlp at start of rotation X1,Y1,Z1
C E1 perp to E2 and E3.
C
C Set up beam vector SO (dimensionless rlu's)
C
SO(1) = -1.0
SO(2) = 0.0
SO(3) = 0.0
E3(1) = 0.0
E3(2) = 0.0
E3(3) = 1.0
XRLP(1) = X1
XRLP(2) = Y1
XRLP(3) = Z1
C
C---- E2 = [E3 x XRLP]/| E3 x XRLP |
C
CALL CROSS(E2,E3,XRLP)
CALL UNIT(E2)
C
C---- E1 = E2 x E3
C
CALL CROSS (E1,E2,E3)
C
C---- Phi value for diffraction given by:
C CEA *cos(phic) + CEB*sin(phic) = CEC
C where:
C CEA = (XRLP.E1) * (E1.SO)
C CEB = (XRLP.E1) * (E2.SO)
C CEC = 0.5*(XRLP.E1)**2 + 0.5*(XRLP.E3)**2 -(XRLP.E3)*(E3.SO)
C
XE1 = DOT(XRLP,E1)
XE3 = DOT(XRLP,E3)
CEA = XE1 * DOT(E1,SO)
CEB = XE1 * DOT(E2,SO)
CEC = 0.5*XE1*XE1 + 0.5*XE3*XE3 - XE3*DOT(E3,SO)
CEABSQ = CEA**2 + CEB**2
C
C---- Skip if rlp lies on rotation axis
C
IF (CEABSQ.LE.0.0) GOTO 10
C
ARG1 = CEC/SQRT(CEABSQ)
IF (ARG1.GT.1.0) ARG1 = 1.0
IF (ARG1.LT.-1.0) ARG1 = -1.0
C
C---- Equation for PHIC has two solutions, we want the one within or closest
C to the phi range. Choose the solution closest to the midpoint of the
C phirange
C
OSCRNG = ABS(PHIEND-PHIBEG)
RMIDPHI = 0.5*(PHIBEG+PHIEND)
T1 = ACOS(ARG1)
T2 = ATAN2(CEB, CEA)
C
C---- First solution
C
PHIC = (T1 + T2)/DTOR
PHIA = PHIBEG + PHIC
C
C---- Second solution
C
PHIC = (-T1 + T2)/DTOR
PHIB = PHIBEG + PHIC
C
DIFF1 = ABS(PHIA-RMIDPHI)
DIFF2 = ABS(PHIB-RMIDPHI)
IF (DIFF1.LT.DIFF2) THEN
PHI = PHIA
ELSE
PHI = PHIB
END IF
C
C---- Now calculate reflection width. First need coordinates of rlp on
C the Ewald sphere. Apply rotation of PHIC to XRLP.
C
CALL SURMP(PHIC*DTOR,PHICR)
CALL MATVEC(XRLPE,PHICR,XRLP)
C
C---- Lorentz factor = | 1.0/(XRLPE.[E3 x SO]) |
C
CALL CROSS (E3SO,E3,SO)
T3 = DOT(E3SO,XRLPE)
RLORF = 0.0
IF (T3.EQ.0.0) GOTO 10
RLORF = ABS(1.0/T3)
C
C---- Is this neccessary?
C
10 IF (DSTAR2.EQ.0.0) THEN
KT = -1
C
C---- Test dstar limit
C
ELSE IF (DSTAR2.GT.DSTPL2) THEN
KT = -2
ELSE
C
C---- Calculate distance from sphere at beginning and end of rotation
C Negative if within sphere
C
DEL1 = SQRT((1.0+X1)**2+Y1S+Z1S) - 1.0
DEL2 = SQRT((1.0+X2)**2+Y2S+Z1S) - 1.0
ADEL1 = ABS(DEL1)
ADEL2 = ABS(DEL2)
C
DST4 = DSTAR2**2*0.25
YMID = (Y1+Y2)*0.5
YMS = YMID*YMID
C
C---- Conventional source geometry
C
C Radius of reciprocal lattice point along radius of Ewald sphere
C RSPOT = 0.5*(DIVERGENCE+dispersion*tan(theta) )*DSTAR*COS(THETA)
C and as DSTAR*COS(THETA) = SQRT(DSTAR**2-0.25*DSTAR**4)
C Note that the divergence parameters DIVH,DIVV and the mosaic spread
C are stored in the generate file as the FULL WIDTHS in degrees.
C These are converted to HALF WIDTHS in radians prior to the prediction
C calculations.
C
IF (ISYN.EQ.0) THEN
DIVERG = SQRT((DIVH**2*Z1S+DIVV**2*YMS)/ (YMS+Z1S))
RSPOT = (DIVERG+ETA)*SQRT(DSTAR2-DST4) + 0.25*DELAMB*DSTAR2
ELSE
C
C---- Synchrotron source geometry
C
C REF. J.APPL.CRYST. 15,493-508 GREENHOUGH & HELLIWELL
C Note that the only difference to above is the inclusion of the
C correlated dispersion term in the horizontal divergence.
C
ESYNH = DELCOR*DSTAR2 + Z1*DIVH
ESYNV = DIVV*YMID
DIVERG = SQRT((ESYNH*ESYNH+ESYNV*ESYNV)/ (YMS+Z1S))
RSPOT = (DIVERG+ETA)*SQRT(DSTAR2-DST4) + 0.25*DELAMB*DSTAR2
END IF
C
C
C---- Reflection width is 2.0*RSPOT*RLORF
C
PHIW = 2.0*RSPOT*RLORF/DTOR
PHIS = PHI - 0.5*PHIW
PHIE = PHIS + PHIW
C
C---- Find smaller ratio of distance of spot from sphere to spot radius.
C This will be >1 for fulls, and is used as measure of "safeness" of
C fulls in AGROVATA (stored as FRACREJ in MTZ file).
C
IF (RSPOT.NE.0.0) DRATIO = MIN(ADEL1/RSPOT,ADEL2/RSPOT)
C
C---- Find over how many images this spot extends and which image this is.
C NB Following code assumes rotation is positive phi, not negative
C
DO 20 I = 1,NWMAX+1
IF ((PHIBEG - (I-1)*OSCRNG).LE.PHIS) THEN
ISTART = I
GOTO 22
END IF
20 CONTINUE
C
C---- Spot is too wide
C
ISTART = NWMAX + 2
C
22 DO 24 I = 1,NWMAX + 1
IF ((PHIEND + (I-1)*OSCRNG).GE.PHIE) THEN
IEND = I
GOTO 26
END IF
24 CONTINUE
C
C---- Spot is too wide
C
IEND = NWMAX + 2
C
26 IWIDTH = ISTART - 1 + IEND - 1 + 1
C
C---- Extra debug
C
IF (DEBUG(38))
+ THEN
WRITE(IOUT,FMT=6010) IP,IQ,IR,PHI,PHIW,PHIS,PHIE,PHIBEG,
+ PHIEND,OSCRNG,ISTART,IEND,IWIDTH,NWMAX
IF (ONLINE) WRITE(ITOUT,FMT=6010) IP,IQ,IR,PHI,PHIW,PHIS,
+ PHIE,PHIBEG,PHIEND,OSCRNG,ISTART,IEND,IWIDTH,NWMAX
6010 FORMAT(1X,'HKL = ',3I4,' PHI=',F12.7,' width=',F12.7,
+ ' start=',F12.7,' end=',F12.7,/,' osc start',F12.7,
+ ' osc end',F12.7,' osc range',F9.6,' ISTART',I3,
+ ' IEND',I3,/,1X,'IWIDTH',I3,' NWMAX',I4)
END IF
C
C
C---- Test for spot within cusp - Radius of spot is same in
C plane perp to rot
C
C Note that one should use the horizontal crossfire term here
C CSIMIN = 0.5*DSTAR2 + RSPOT
C CSIMIN2 = CSIMIN*CSIMIN = .25*DSTAR2*DSTAR2 + DSTAR2*RSPOT +RSPOT*RSPOT
C Ignore RSPOT**2 term
C
CSIMIN2 = RSPOT*DSTAR2 + DST4
C
C
IF (XYS.LT.CSIMIN2) THEN
KT = -3
C
C---- What should csimin test be ? The spot can still appear on image
C even if the centre of the rlp never cuts the sphere (ie lies in
C the cusp region) providing any part of the rlp touches the sphere.
C In this case, the test on line below is the right one, but this
C seems to overpredict in practice, so limit it to case where the
C centre of the rlp must intersect the sphere.
CAL IF (XYS.LT.(DST4-RSPOT*DSTAR2)) KT = -4
IF (XYS.LT.DST4) KT = -4
ELSE
C
C---- Calculate distance of edge of spot from sphere at end of rotation
C
DIST2 = ADEL2 - RSPOT
C
C---- Test if spot is cut at beginning of rotation
C Set DELEPS to a negative value - Fraction recorded set to 100.*DELEPS
C Note sign change depending on whether Y is +ve or -ve
C
IF (ADEL1-RSPOT.LE.0.0) THEN
ISY = NINT(SIGN(1.0,Y1))
DELEPS1 = - (ISY*DEL1/RSPOT+1.0)*0.5
C
C---- Spot cut at beginning - check for cut at both ends
C
IF (DIST2.LT.0.0) THEN
ISY = NINT(SIGN(1.0,Y2))
DELEPS2 = (1.0-ISY*DEL2/RSPOT)*0.5
C
C---- Assign KH flag (see above)
C
IF (IWIDTH.GT.NWMAX) THEN
KH = 3
ELSE
KH = IPAD*IWIDTH + ISTART
END IF
ELSE
C
C---- Spot only cut at beginning.
C
IF (IWIDTH.GT.NWMAX) THEN
KH = 3
ELSE
KH = IPAD*IWIDTH + ISTART
END IF
END IF
C
C---- Test if spot is only cut at end of rotation
C
ELSE IF (DIST2.LE.0.0) THEN
ISY = NINT(SIGN(1.0,Y2))
DELEPS2 = (1.0-ISY*DEL2/RSPOT)*0.5
IF (IWIDTH.GT.NWMAX) THEN
KH = 3
ELSE
KH = IPAD*IWIDTH + ISTART
END IF
ELSE
C
C---- Spot is cut at neither end of rotation.
C To be recorded spot must lie within one sphere
C and outside the other
C
IF (DEL1.LT.0) THEN
IF (DEL2.GE.0) GO TO 40
ELSE IF (DEL2.LT.0) THEN
GO TO 40
END IF
C
C
KT = -1
40 IF (DEBUG(38)) THEN
ICOUNT = ICOUNT + 1
IF (ICOUNT.EQ.1) THEN
WRITE(IOUT,FMT=6000) PHIBEG,PHIEND,WAVE,E1,E2,
+ E3,SO,IAX
IF (ONLINE) WRITE(ITOUT,FMT=6000) PHIBEG,
+ PHIEND,WAVE,E1,E2,E3,SO,IAX
6000 FORMAT(1X,'IN DSTAR PHIBEG,PHIEND,WAVE',2F9.3,
+ F9.5,/,1X,'E1',3F10.5,/,1X,'E2',3F10.5,/,
+ 1X,'E3',3F10.5,/,1X,'SO',3F10.5,/,1X,
+ 'IP is index',I3,' IQ is index',I3,
+ ' IR is index',I3)
END IF
IF (ICOUNT.LT.NDEBUG(38)) THEN
WRITE(IOUT,FMT=6002) IP,IQ,IR,XRLP,XRLPE,DSTAR2,KT,
+ KH,PHI,PHIS,PHIE,PHIW,RLORF,ISTART,IEND,
+ IWIDTH,DELEPS1,DELEPS2
IF (ONLINE) WRITE(ITOUT,FMT=6002) IP,IQ,IR,XRLP,
+ XRLPE,DSTAR2,KT,KH,PHI,PHIS,PHIE,PHIW,RLORF,
+ ISTART,IEND,IWIDTH,DELEPS1,DELEPS2
6002 FORMAT(1X,'IP,IQ,IR',3I5,/,1X,'RLP coordinates at',
+ ' PHIBEG (dimensionless rlu)',3F10.5,/,1X,
+ 'at the diffraction position',18X,3F10.5,/,1X,
+ 'dstar,KT,KH',F10.5,2I4,/,1X,
+ 'PHI (on sphere) PHIS, PHIE, PHIWIDTH,',
+ 'Lor fact',F10.3,3F8.3,F8.2,
+ ' ISTART,IEND,IWIDTH',3I3,
+ ' DELEPS1',F6.3,' DELEPS2',F6.3)
END IF
END IF
RETURN
END IF
END IF
END IF
C
IF (DEBUG(38)) THEN
ICOUNT = ICOUNT + 1
IF (ICOUNT.EQ.1) THEN
WRITE(IOUT,FMT=6000) PHIBEG,PHIEND,WAVE,E1,E2,E3,SO,IAX
IF (ONLINE) WRITE(ITOUT,FMT=6000) PHIBEG,PHIEND,WAVE,
+ E1,E2,E3,SO,IAX
END IF
IF (ICOUNT.LT.NDEBUG(38)) THEN
WRITE(IOUT,FMT=6002) IP,IQ,IR,XRLP,XRLPE,DSTAR2,KT,KH,
+ PHI,PHIS,PHIE,PHIW,RLORF,ISTART,IEND,IWIDTH,
+ DELEPS1,DELEPS2
IF (ONLINE) WRITE(ITOUT,FMT=6002) IP,IQ,IR,XRLP,XRLPE,
+ DSTAR2,KT,KH,PHI,PHIS,PHIE,PHIW,RLORF,ISTART,IEND,
+ IWIDTH,DELEPS1,DELEPS2
END IF
END IF
C
END
SUBROUTINE EA06CD(A,VALUE,VECTOR,M,IA,IV,W)
C
C finds all eigenvalues and eigenvectors for a real symmetric matrix A. The
C eigenvectors are normalized to have unit length.
C
C STANDARD FORTRAN 66 (A VERIFIED PFORT SUBROUTINE)
C
DOUBLE PRECISION A,PP,VALUE,VECTOR,W
DIMENSION A(IA,M),VALUE(M),VECTOR(IV,M),W(*)
M1=M+1
M2=M1+M
W(1)=A(1,1)
IF(M-2)60,10,15
10 W(2)=A(2,2)
W(4)=A(2,1)
GO TO 60
15 CALL MC04BD(A,W,W(M1),M,IA,W(M2))
60 CALL EA08CD(W,W(M1),VALUE,VECTOR,M,IV,W(M2))
IF(M.LE.2)RETURN
DO 56 L=1,M
DO 56 II=3,M
I=M-II+1
M3=M1+I
IF(W(M3))57,56,57
57 PP=0.0D0
I1=I+1
DO 58 K=I1,M
58 PP=PP+A(I,K)*VECTOR(K,L)
PP=PP/(A(I,I+1)*W(M3))
DO 59 K=I1,M
59 VECTOR(K,L)=VECTOR(K,L)+PP*A(I,K)
56 CONTINUE
RETURN
END
SUBROUTINE MC04BD(A,ALPHA,BETA,M,IA,Q)
C STANDARD FORTRAN 66 (A VERIFIED PFORT SUBROUTINE)
C
C Transforms a real symmetric matirx into a tridiagonal matrix having the
C same eigenvalues as A.
C
DOUBLE PRECISION A,ALPHA,BETA,BIGK,H,Q,QJ,PP,PP1
DIMENSION A(IA,*),ALPHA(*),BETA(*),Q(*)
ALPHA(1)=A(1,1)
DO 21 J=2,M
J1=J-1
DO 22 I=1,J1
A(I,J)=A(J,I)
22 CONTINUE
ALPHA(J)=A(J,J)
21 CONTINUE
M1=M-1
M2=M-2
DO 1 I=1,M2
PP=0.0D0
I1=I+1
DO 2 J=I1,M
PP=PP+A(I,J)**2
2 CONTINUE
PP1=DSQRT(PP)
IF(A(I,I+1))3,5,5
5 BETA(I+1)=-PP1
GO TO 6
3 BETA(I+1)=PP1
6 IF(PP)1,1,17
17 H=PP-BETA(I+1)*A(I,I+1)
A(I,I+1)=A(I,I+1)-BETA(I+1)
DO 7 KI=I1,M
QJ=0.0D0
DO 8 KJ=I1,KI
QJ=QJ+A(KJ,KI)*A(I,KJ)
8 CONTINUE
IF(KI-M)19,20,20
19 I2=KI+1
DO 18 KJ=I2,M
QJ=QJ+A(KI,KJ)*A(I,KJ)
18 CONTINUE
20 Q(KI)=QJ/H
7 CONTINUE
BIGK=0.0D0
DO 9 KJ=I1,M
BIGK=BIGK+A(I,KJ)*Q(KJ)
9 CONTINUE
BIGK=BIGK/(2.0*H)
DO 10 KJ=I1,M
Q(KJ)=Q(KJ)-BIGK*A(I,KJ)
10 CONTINUE
DO 11 KI=I1,M
DO 12 KJ=KI,M
A(KI,KJ)=A(KI,KJ)-Q(KI)*A(I,KJ)-Q(KJ)*A(I,KI)
12 CONTINUE
11 CONTINUE
1 CONTINUE
DO 23 I=2,M
H=ALPHA(I)
ALPHA(I)=A(I,I)
A(I,I)=H
23 CONTINUE
BETA(M)=A(M-1,M)
RETURN
END
SUBROUTINE EA08CD(A,B,VALUE,VEC,M,IV,W)
C STANDARD FORTRAN 66 (A VERIFIED PFORT SUBROUTINE)
DOUBLE PRECISION A,A11,A12,A13,A21,A22,A23,A33,A34,B,BB,CC,
1 CO,EPS,ROOT,S,SI,SML,VALUE,VEC,V1,V2,W,XAX,XX
DIMENSION A(M),B(M),VALUE(M),VEC(*),W(*)
CC DATA EPS/1.0D-6/,A34/0.0D0/
DATA EPS/2.3D-16/,A34/0.0D0/
C THIS USES QR ITERATION TO FIND THE EIGENVALUES AND EIGENVECTORS
C OF THE SYMMETRIC TRIDIAGONAL MATRIX WHOSE DIAGONAL ELEMENTS ARE
C A(I),I=1,M AND OFF-DIAGONAL ELEMENTS ARE B(I),I=2,M. THE ARRAY
C W IS USED FOR WORKSPACE AND MUST HAVE DIMENSION AT LEAST 2*M.
C WE TREAT VEC AS IF IT HAD DIMENSIONS (IV,M).
SML=EPS*FLOAT(M)
CALLEA09CD(A,B,W(M+1),M,W)
C SET VEC TO THE IDENTITY MATRIX.
DO 5 I=1,M
VALUE(I)=A(I)
W(I)=B(I)
K=(I-1)*IV+1
L=K+M-1
DO 3 J=K,L
3 VEC(J)=0.0D0
KI=K+I
5 VEC(KI-1)=1.D0
K=0
IF(M.EQ.1)RETURN
DO 200 N3=2,M
N2=M+2-N3
C EACH QR ITERATION IS PERFORMED OF ROWS AND COLUMNS N1 TO N2
MN2=M+N2
ROOT=W(MN2)
DO 190 ITER=1,20
BB=(VALUE(N2)-VALUE(N2-1))*0.5D0
CC=W(N2)*W(N2)
A22=VALUE(N2)
IF(CC.NE.0.0D0)A22=A22+CC/(BB+DSIGN(1.0D0,BB)*DSQRT(BB*BB+CC))
DO 125 I=1,N2
MI=M+I
IF(DABS(ROOT-A22).LE.DABS(W(MI)-A22))GO TO 125
ROOT=W(MI)
MN=M+N2
W(MI)=W(MN)
W(MN)=ROOT
125 CONTINUE
DO 130 II=2,N2
N1=2+N2-II
IF(DABS(W(N1)).LE.(DABS(VALUE(N1-1))+DABS(VALUE(N1)))*SML)GOTO140
130 CONTINUE
N1=1
140 IF(N2.EQ.N1) GO TO 200
N2M1=N2-1
IF(ITER.GE.3)ROOT=A22
K=K+1
A22=VALUE(N1)
A12=A22-ROOT
A23=W(N1+1)
A13=A23
DO180 I=N1,N2M1
A33=VALUE(I+1)
IF(I.NE.N2M1)A34=W (I+2)
S=DSIGN(DSQRT(A12*A12+A13*A13),A12)
SI=A13/S
CO=A12/S
JK=I*IV+1
J1=JK-IV
J2=J1+MIN0(M,I+K)-1
DO 160 JI=J1,J2
V1=VEC(JI)
V2=VEC(JK)
VEC(JI)=V1*CO+V2*SI
VEC(JK)=V2*CO-V1*SI
160 JK=JK+1
IF(I.NE.N1) W(I)=S
A11=CO*A22+SI*A23
A12=CO*A23+SI*A33
A13=SI*A34
A21=CO*A23-SI*A22
A22=CO*A33-SI*A23
A23=CO*A34
VALUE(I)=A11*CO+A12*SI
A12=-A11*SI+A12*CO
W(I+1)=A12
180 A22=A22*CO-A21*SI
190 VALUE(N2)=A22
WRITE(6,195)
195 FORMAT(48H1CYCLE DETECTED IN SUBROUTINE EA08 -STOPPING NOW)
STOP
200 CONTINUE
C RAYLEIGH QUOTIENT
DO 220 J=1,M
K=(J-1)*IV
XX=VEC(K+1)**2
XAX=XX*A(1)
DO 210 I=2,M
KI=K+I
XX=XX+VEC(KI)**2
210 XAX=XAX+VEC(KI)*(2.0D0*B(I)*VEC(KI-1)+A(I)*VEC(KI))
220 VALUE(J)=XAX/XX
RETURN
END
SUBROUTINE EA09CD(A,B,VALUE,M,OFF)
C STANDARD FORTRAN 66 (A VERIFIED PFORT SUBROUTINE)
DOUBLE PRECISION A,A11,A12,A13,A21,A22,A23,A33,A34,B,BB,
1 CC,CO,EPS,OFF,ROOT,S,SBB,SI,SML,VALUE
DIMENSION A(M),B(M),VALUE(M),OFF(M)
CC DATA A34/0.0D0/,EPS/1.0D-6/
DATA A34/0.0D0/,EPS/2.3D-16/
SML=EPS*FLOAT(M)
VALUE(1)=A(1)
IF(M.EQ.1)RETURN
DO 10 I=2,M
VALUE(I)=A(I)
10 OFF(I)=B(I)
C EACH QR ITERATION IS PERFORMED OF ROWS AND COLUMNS N1 TO N2
MAXIT=10*M
DO 90 ITER=1,MAXIT
DO 45 N3=2,M
N2=M+2-N3
DO 30 II=2,N2
N1=2+N2-II
IF(DABS(OFF(N1)).LE.(DABS(VALUE(N1-1))+DABS(VALUE(N1)))*SML)GOTO40
30 CONTINUE
N1=1
40 IF(N2.NE.N1) GO TO 50
45 CONTINUE
RETURN
C ROOT IS THE EIGENVALUE OF THE BOTTOM 2*2 MATRIX THAT IS NEAREST
C TO THE LAST MATRIX ELEMENT AND IS USED TO ACCELERATE THE
C CONVERGENCE
50 BB=(VALUE(N2)-VALUE(N2-1))*0.5D0
CC=OFF(N2)*OFF(N2)
SBB=1.0D0
IF(BB.LT.0.0D0)SBB=-1.0D0
ROOT=VALUE(N2)+CC/(BB+SBB*DSQRT(BB*BB+CC))
N2M1=N2-1
75 A22=VALUE(N1)
A12=A22-ROOT
A23=OFF(N1+1)
A13=A23
DO 80 I=N1,N2M1
A33=VALUE(I+1)
IF(I.NE.N2M1)A34=OFF(I+2)
S=DSQRT(A12*A12+A13*A13)
SI=A13/S
CO=A12/S
IF(I.NE.N1)OFF(I)=S
A11=CO*A22+SI*A23
A12=CO*A23+SI*A33
A13=SI*A34
A21=CO*A23-SI*A22
A22=CO*A33-SI*A23
A23=CO*A34
VALUE(I)=A11*CO+A12*SI
A12=-A11*SI+A12*CO
OFF(I+1)=A12
80 A22=A22*CO-A21*SI
90 VALUE(N2)=A22
WRITE(6,100)
100 FORMAT(39H1LOOPING DETECTED IN EA09-STOPPING NOW )
STOP
END
c estimate_mosaicity.f
c maintained by G.Winter
c 16th May 2002
c
c
c Replacement for mosaic estimate
c
c
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
subroutine estimate_mosaicity(argc, argv, types, values)
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
mosest = .true.
call estmos(nimag)
mosest = .false.
return
end
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE ESTMOS(NIMAG)
IMPLICIT NONE
C
C---- integer arguments
C
INTEGER NIMAG
C
C---- Estimates mosaicity based on current crystal and detector
C parameters, using code in AUTOMATCH.
C
C---- include files
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C
C---- following line only needed while xdl stuff still used
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C---- following line only needed while xdl stuff still used
C
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/mxdspl.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C---- START of include file mxdspl.h
C
C
C---- PARAMETERS first
C
INTEGER NPARM
PARAMETER (NPARM = 200)
INTEGER MAXSEG
PARAMETER (MAXSEG = 20)
INTEGER NCIRC
PARAMETER (NCIRC=4)
C Circle points
INTEGER MAXCPT
PARAMETER (MAXCPT = 200)
C
INTEGER LCLEAN, IEXTYZ, LCORRC
C
C JIMGN(1) first image number
C JIMGN(2) number of images
INTEGER JIMGN
C
C MENU ITEM NUMBERS
INTEGER MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,MBADSP,
+ MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,MMEAS,
+ MCIRC,MREAD,MFIND,MEDIT,MMOSA,MCLRSPT,MSEL,MAUTO,MPRED,
+ MCLRPRD,MPREF,MINTEG,MSTRAT,MKEYWD,MADJ2,MFHKL,MCIRCF
C Possible ones to be added ?
INTEGER ISCL
C
C Active object list
C ivhlist(1) menu
C ivhlist(2) parameters
C ivhlist(3) image
INTEGER NUMVH, IVHLIST,IVH, NUMVH2, IVHLIST2
c npx number of points in box
INTEGER NPX
INTEGER IVECB, IVECC
C .. local scalars ..
INTEGER I,J,IQUIT,ISTAT,IERR,MEASUR,ITEM,IX,IY,L,M,JY,JZ,NSOL,
$ NADDS,MODEG,NFULLF
INTEGER IX1,IY1,IX2,IY2,JY2,JZ2, IZOOM, MEASPT, NORDER,
+ IXM, IYM, IXP, IYP, KFLAG, IBUTTON,IFLAG, IISIZE,
+ NDISPP,IRECG,IJUNK,IFAIL,NCH,NCH2,MODEOP,ID,NFIRSTI,MODESP,
+ MODECTRL,IPACKF,IPACKL,NSERLOC,LINELEN,NUMLIN,IPAUSE,
+ ICOUNT,JSEG,IM1,JIMAG,K,ICHECK,NTOT,ICOLR,JFIRST,ITOG,
+ IPACK,NPROC,IXCEN,IYCEN,IRMIN,IRMAX,MODEGSR,ISTRTSV,
+ IANGLESV,IFLAGPR,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ MODEDISP,NUMSAVE,NPROFL,NUMBLOCK,IERR2
C Circle points
INTEGER NCIRPT, MCIRPT, IXYCPT, MAXDPT
INTEGER INCIMG,MSECS
INTEGER IADJP,NDISP
C JDSPAU auto display flag, .gt. 0 for image display in
C Find & Collect: display every JDPSAUth image
INTEGER JDSPAU
C .. Local arrays ..
INTEGER IXADJ,IYADJ,IHKL,IHKLX,IMS1,
+ IMF1
C
C things for parser
C
INTEGER IBEG,IDEC,IEND,ITYP
INTEGER NTOK
C
C---- Real variables
C
C Menu
REAL RESCMX
REAL RESCIR
c
c pxavg average of box
c pxrms rms of box
REAL PXAVG, PXRMS
C
C .. Local Scalars ..
REAL PHIBEGS,XSEP,YSEP,OMEGAFD,RX,RY,TOTPHI,PRWIDTH,THETA,
+ OHDIST,X,MAXCELL
c
c Circle points
REAL CIRCEN, CIRRAD
C
C---- Following needed for call to CONTROL
C
REAL DUMMY, RESOL, SPACNG, XMEASPT,RJY,RJZ,DTOR,RAD,
+ PHISTART
C ..
C .. Local Arrays ..
REAL PSI,PHIPRF,OSCPRF
C
C---- Things for parser
C
REAL VALUE
C
C---- now for character variables
C
C Menu
CHARACTER*(MAX_MEN_NAME) MENU_ITEMS,
+ MENU_ITEMS2
C
CHARACTER*(MAX_MEN_NAME) EXIT_NAME
C ..
C .. Local Scalars ..
CHARACTER PROMPT*80, LINE*80, STR*100 ,TEMPCH*100,
+ STR1*1,STR2*4,STR3*4,STR4*7,LINE2*80,SUBKEY*4,KEY*4,
+ BIGLINE*120,STR5*9,VALUESTR*80,WAXFNN*134,MTZNAMP*80
CHARACTER STORIMAG*200
C
C---- Following needed for call to CONTROL
C
CHARACTER CELLSTR*50
C
CHARACTER FNAME
C .. Local Arrays ..
CHARACTER MATFILN*70,IDENTPRF*80
C
C---- finally, LOGICALS
C
LOGICAL CALC_VB1,CALC_VB2
C
C---- local scalars
C
LOGICAL PREDICTED,SNEWGENF,EFILE,GIVEMAT,BOXOPEN,LPRNT,
+ UPDATE,NEWRAST,NEWSEP,FORCEREAD,GENFILESET,BADTOG,
+ NEWCELL,NPSI,BOXOPEN2,RFRESH,SAVED,RFIXCELL,RFIXDIST,
+ NULINE,NEWWIN,AUTOIND,CHRMIN,CHRMAX,ADDSPOTS,AUTOINDS,
+ DEFPHI,GWRITE,DOPROFILE,FAIL,LIST,SNOCENT,SNOREFINE,
$ SRMOSAIC,SFIRSTFILM,SGENOPEN,SFIRSTTIME,smultiseg,
$ JUMPBACK,ADDPP
C Circle points
LOGICAL LFITCIRC
C needed for call to control
LOGICAL FIRSTTIME,NEWGENF,RPTFIRST
LOGICAL LPICK,LPLRNG,PICKED,CIRCLES,NEWRES,NEWSCL,LAUTOM,LPRKBC,
+ LIN1,ADJUST,LINDEX,LSPOT,LSPEDIT,LKILL,NTHRESH,NSCAL,MENU2,
+ ROTATED,NEWSPOTS,LBADSP,LDISPSPT
LOGICAL DPS_INDEX,DPS_SEARCH
C .. local arrays ..
LOGICAL INMAT
COMMON /GUIVAR/LCLEAN(3),IEXTYZ(2),LCORRC,
$ JIMGN(2),MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,
+ MBADSP,MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,
+ MMEAS,MCIRC,MREAD,MFIND,MEDIT,MMOSA,MCLRSPT,MSEL,MAUTO,
+ MPRED,MCLRPRD,MPREF,MINTEG,MSTRAT,MKEYWD,MADJ2,MFHKL,
$ MCIRCF,ISCL,NUMVH,IVHLIST(3),IVH,NUMVH2,IVHLIST2(3),NPX,
$ IVECB,IVECC,I,J,IQUIT,ISTAT,IERR,MEASUR,ITEM,IX,IY,L,M,JY,
$ JZ,NSOL,NADDS,MODEG,NFULLF,
$ IX1,IY1,IX2,IY2,JY2,JZ2, IZOOM, MEASPT(2,2), NORDER,
+ IXM, IYM, IXP, IYP, KFLAG, IBUTTON,IFLAG, IISIZE,
+ NDISPP,IRECG,IJUNK,IFAIL,NCH,NCH2,MODEOP,ID,NFIRSTI,
+ MODESP,MODECTRL,IPACKF,IPACKL,NSERLOC,LINELEN,NUMLIN,
+ IPAUSE,ICOUNT,JSEG,IM1,JIMAG,K,ICHECK,NTOT,ICOLR,JFIRST,
+ ITOG,IPACK,NPROC,IXCEN,IYCEN,IRMIN,IRMAX,MODEGSR,ISTRTSV,
+ IANGLESV,IFLAGPR,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ MODEDISP,NUMSAVE,NPROFL,NUMBLOCK,IERR2,NCIRPT,
$ MCIRPT,IXYCPT(2,MAXCPT), MAXDPT,INCIMG,MSECS,IADJP,NDISP,
$ JDSPAU,IXADJ(4),IYADJ(4),IHKL(5),IHKLX(5),IMS1(MAXSEG),
+ IMF1(MAXSEG),IBEG(NPARM),IDEC(NPARM),IEND(NPARM),
$ ITYP(NPARM),NTOK,
$ RESCMX,RESCIR(NCIRC),PXAVG, PXRMS,PHIBEGS,XSEP,YSEP,
$ OMEGAFD,RX,RY,TOTPHI,PRWIDTH,THETA,OHDIST,X,MAXCELL,
$ CIRCEN(2), CIRRAD,DUMMY, RESOL, SPACNG, XMEASPT(2,2),RJY,
$ RJZ,DTOR,RAD,PHISTART,PSI(3),PHIPRF(MAXSEG),
$ OSCPRF(MAXSEG),VALUE(NPARM)
COMMON /GUICHA/ MENU_ITEMS(MAX_MEN_ITMS),
+ MENU_ITEMS2(MAX_MEN_ITMS),
$ EXIT_NAME,
$ PROMPT, LINE, STR ,TEMPCH,
+ STR1,STR2,STR3,STR4,LINE2,SUBKEY,KEY,
+ BIGLINE,STR5,VALUESTR,WAXFNN,MTZNAMP,
$ STORIMAG,CELLSTR,FNAME,MATFILN(MAXSEG),
$ IDENTPRF(MAXSEG)
COMMON /GUILOG/CALC_VB1,CALC_VB2,
$ PREDICTED,SNEWGENF,EFILE,GIVEMAT,BOXOPEN,LPRNT,
+ UPDATE,NEWRAST,NEWSEP,FORCEREAD,GENFILESET,BADTOG,
+ NEWCELL,NPSI,BOXOPEN2,RFRESH,SAVED,RFIXCELL,RFIXDIST,
+ NULINE,NEWWIN,AUTOIND,CHRMIN,CHRMAX,ADDSPOTS,AUTOINDS,
+ DEFPHI,GWRITE,DOPROFILE,FAIL,LIST,SNOCENT,SNOREFINE,
$ SRMOSAIC,SFIRSTFILM,SGENOPEN,SFIRSTTIME,smultiseg,
$ JUMPBACK,ADDPP,LFITCIRC, FIRSTTIME,NEWGENF,RPTFIRST,
$ LPICK,LPLRNG,PICKED,CIRCLES,NEWRES,NEWSCL,LAUTOM,LPRKBC,
+ LIN1,ADJUST,LINDEX,LSPOT,LSPEDIT,LKILL,NTHRESH,NSCAL,
+ MENU2,ROTATED,NEWSPOTS,LBADSP,LDISPSPT,DPS_INDEX,
$ DPS_SEARCH,INMAT(MAXSEG)
C&&*&& end_include ../inc/mxdspl.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/praccum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file praccum.h
C---- START of include file praccum.h
C
C
C ..
C .. Arrays in common block /PRACCUM/ ..
REAL PRDATA
C
C .. Scalars in common block /PRACCUM/ ..
LOGICAL ACCUMULATE,FIRSTPASS,SECONDPASS,THIRDPASS,FIRSTFILM,
+ NOTREAD
C ..
C .. Common Block /PRACCUM/ ..
COMMON /PRACCUM/PRDATA(4,50),ACCUMULATE,FIRSTPASS,SECONDPASS,
+ THIRDPASS,FIRSTFILM,NOTREAD
C ..
C
C
C&&*&& end_include ../inc/praccum.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
C
C---- Local scalars
C
INTEGER IFIRSTPACK
CHARACTER LINE1K*1024
character*1024 xmlline
INTEGER LENSTR
EXTERNAL LENSTR
LOGICAL GENOPEN
DTOR = ATAN(1.0)*4.0/180.0
IERR = 0
C
C---- First check we have an orientation
C
write(*, *) 'STARTING ESTMOS'
IF ((IMAT.EQ.0).AND.(IUMAT.EQ.0)) THEN
IERR = 1
6000 FORMAT(4(/,'**** WARNING ****'),/,
$ 80('-'),/,12X,'Cannot estimate the mosaicity, ',
$ 'no orientation given',/,12X,'You may wish to index the',
$ ' image first',/,80('-'))
WRITE(IOUT,FMT=6000)
IF(ONLINE)WRITE(ITOUT,FMT=6000)
IF(SOCKLO)THEN
LINE1K = ''//
$ 'error'//
$ 'AMAT necessary for mosaicity '//
$ 'estimation '
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(line1k),LINE1K)
ENDIF
C
C---- XDL stuff
C
IF(WINOPEN)THEN
WRITE(LINE,FMT=6005)
6005 FORMAT('Cannot estimate the mosaicity, ',
$ 'no orientation given')
L = LENSTR(LINE)
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
ENDIF
C
C---- end of XDL stuff
C
RETURN
END IF
C
C---- now check that we have actually specified an image at some point...
C
IF((LENSTR(WAXFN).LE.0).AND.(LENSTR(IDENT).LE.0))THEN
IERR = 1
IF(SOCKLO)THEN
LINE1K = ''//
$ 'error'//
$ 'No image name given'
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(line1k),LINE1K)
ENDIF
6007 FORMAT(4(/,'**** WARNING ****'),/,
$ 80('-'),/,12X,'An image must be specified for the ',
$ 'mosaicity estimation!',/,12X,'The keywords ',
$ 'MOSAIC ESTIMATE should follow "AUTOINDEX DPS"',/,12X,
$ 'or "PROCESS" or "IMAGE" keywords',/,80('-'))
WRITE(IOUT,FMT=6007)
IF(ONLINE)WRITE(ITOUT,FMT=6007)
RETURN
ENDIF
C
LOGETA = .FALSE.
C
C---- If no AMAT has yet been calculated, do that now
C
IF (IMAT.EQ.0) THEN
ICHECK = 1
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
IMAT = 1
C
C---- Can now set IUMAT to zero, so we do not get error message about
C input I matrix being ignored from predict
C
IUMAT = 0
END IF
C
C
C---- Need to call CONTROL to set up detector limits etc
C
MODECTRL = 1
C
C---- If GENFILE not set, set a default value
C
IF (IGENF.EQ.0) THEN
IF(LENSTR(WAXFN).GT.0)THEN
GENFILE = WAXFN(1:LENSTR(WAXFN))//'.gen'
ELSE
GENFILE = IDENT(1:LENSTR(IDENT))//'.gen'
ENDIF
END IF
C
C---- If no raster parameters given, set up values based on median
C spot size in centre of image. Need to do this here so that the
C new parameters are stored as part of the input
C
IF ((IRAST.EQ.0).OR.(ISEP.EQ.0)) THEN
NEWRAST = (IRAST.EQ.0)
NEWSEP = (ISEP.EQ.0)
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWRAST = .FALSE.
NEWSEP = .FALSE.
IF(SOCKLO)THEN
LINE1K = ''//
$ 'error'//
$ 'Error in determining spot separation'//
$ ''
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(line1k),
$ LINE1K)
ENDIF
WRITE(IOUT,FMT=6010)
IF(ONLINE)WRITE(ITOUT,FMT=6010)
6010 FORMAT('Error on return from GETSEPRAS. Cannot ',
$ 'continue in estimation of mosaicity')
IERR = 1
RETURN
END IF
END IF
C
C---- Set NEWGENF TRUE so it does CALL START IN CONTROL
C (which opens a generate file and checks raster box)
C
SMULTISEG = MULTISEG
MULTISEG = .TRUE.
SNEWGENF = NEWGENF
NEWGENF = .TRUE.
GENOPEN = .FALSE.
FIRSTTIME = .FALSE.
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
NEWGENF = SNEWGENF
MULTISEG = SMULTISEG
C
C---- set up bits for AUTOMATCH
C
SNOCENT = NOCENT
SNOREFINE = NOREFINE
SRMOSAIC = RMOSAIC
SFIRSTFILM = FIRSTFILM
NOCENT = .TRUE.
NOREFINE = .TRUE.
RMOSAIC = .TRUE.
FIRSTFILM = .TRUE.
ETAMAX = MAX(1.0,PHIRNG)
IF(RES.GT.0.0)THEN
RESOL1 = RES
ELSE
RESOL1 = RESCMX
ENDIF
IF(RESLOW.GT.0.0)THEN
RESOL2 = RESLOW
ELSE
RESOL2 = 200.0
ENDIF
RCONV = 0.1
OVRLAP = 0.1
NSTEP = 10
NUMBLOCK = 1
C
C Create IO window - XDL stuff only
C
IF(WINOPEN)THEN
IXM = 400
IYM = 300
LINELEN = 80
NUMLIN = 9
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = ' '
WRITE (LINE, 6020)
6020 FORMAT (1X,'Estimating mosaicity for this image. This ',
$ 'will take a few seconds ')
CALL MXDWIO(LINE, 3)
CALL MXDBSY(1,'Estimating mosaicity')
ENDIF
C
C---- Estimate mosaicity
C
c MOSEST = .TRUE.
CALL AUTOMATCH(DOPROFILE,NSTEP,IXSHIFT,IYSHIFT,NPROFL,LIMIT,
+ SEP,VLIM,FAIL,LIST,USEBOX,
+ ADDPP,RWEIGHT,PTMIN,
+ REFREJ,THICK,FIRSTFILM,NUMBLOCK,MOSEST,IERR2)
MATCH = .FALSE.
MOSEST = .FALSE.
NRUN = 1
NOCENT = SNOCENT
NOREFINE = SNOREFINE
RMOSAIC = SRMOSAIC
FIRSTFILM = SFIRSTFILM
C
C---- check if this is okay
C
IF(MOSNEW.NE.999.0)THEN
WRITE (IOUT, 6030)MOSNEW
IF(ONLINE)WRITE (ITOUT, 6030)MOSNEW
IF(WINOPEN)THEN
WRITE (IOLINE, 6030)MOSNEW
CALL WINDIO(NULINE)
ENDIF
IF(SOCKLO)THEN
xmlline = ' '
WRITE(xmlline,FMT=6025)MOSNEW
C 6025 FORMAT(' ',/)
6025 format('',
$ 'ok',
$ '',
$ F4.2, '')
CALL write_socket_length(SERVERFD,lenstr(xmlline),xmlline)
ENDIF
6030 FORMAT (1X,'The mosaicity has been estimated as ---> ',
$ F4.2,' <--- for this image only; ',/,'This ',
$ 'value can be used cautiously as an initial ',
$ 'estimate.')
C
C----
C
IF(SLOPE.GT.5000)THEN
IF(SOCKLO)THEN
C LINE1K = ''//
C $ 'This estimate is affected badly by the '//
C $ 'background; this may be due to noise or '//
C $ 'thermal diffuse scattering '
xmlline = '' //
$ 'error'//
$ 'This estimate was badly affected by the background' //
$ ''
CALL WRITE_SOCKET_length(SERVERFD,lenstr(xmlline),xmlline)
ENDIF
WRITE (IOUT, 6040)
IF(ONLINE)WRITE (ITOUT, 6040)
IF(WINOPEN)THEN
WRITE (IOLINE, 6040)
CALL WINDIO(NULINE)
ENDIF
6040 FORMAT (1X,'This estimate is affected badly by the ',
$ 'background; this may be due to ',/,'noise or ',
$ 'thermal diffuse scattering')
C
C----
C
ELSEIF(SLOPE.GT.2500)THEN
IF(SOCKLO)THEN
LINE1K = ''//
$ 'warning'//
$ 'This estimate is affected by the '//
$ 'background; this may be due to '//
$ 'thermal diffuse scattering '
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(line1k),LINE1K)
ENDIF
WRITE (IOUT, 6050)
IF(ONLINE)WRITE (ITOUT, 6050)
IF(WINOPEN)THEN
WRITE (IOLINE, 6050)
CALL WINDIO(NULINE)
ENDIF
6050 FORMAT (1X,'This estimate is affected by the ',
$ 'background, which may show evidence of',/,
$ 'thermal diffuse scattering')
ENDIF
C
C---- XDL i/o stuff
C
IF(WINOPEN)THEN
WRITE (LINE, 6060)
6060 FORMAT (1X,'Do you want to accept this value [Y]? ')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
ETA = MOSNEW*DTOR/2.0
C
C---- Need to set SETA so that it isn't reset back to start value if
C there are large shifts in refinement
C
SETA = ETA
LOGETA = .TRUE.
END IF
CALL MXDBSY(-1,' ')
ELSE
ETA = MOSNEW*DTOR/2.0
SETA = ETA
LOGETA = .TRUE.
ENDIF
ELSE
IERR = 1
IF(SOCKLO)THEN
LINE1K = ''//
$ 'error'//
$ 'Unable to estimate mosaicity automatically '//
$ 'from this image - determine a value optically'//
$ ''
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(line1k),LINE1K)
ENDIF
LINE = ' '
WRITE (IOUT, 6080)
IF(ONLINE)WRITE (ITOUT, 6080)
6080 FORMAT (1X,12('*'),1X,3('WARNING! '),12('*'),/,
$ 'The mosaicity has NOT been estimated;',
$ ' You should examine the images',/,
$ 'carefully to determine a value manually')
IF(WINOPEN)THEN
WRITE (IOLINE, 6080)
CALL WINDIO(NULINE)
WRITE (LINE, 6090)
6090 FORMAT (1X,'Press to proceed ')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
CALL MXDBSY(-1,' ')
ENDIF
ENDIF
c this might be broken... :)
IF (GENOPEN) then
CALL QCLOSE(IUNIT)
GENOPEN = .FALSE.
IGENF = 0
END IF
RETURN
END
C---- estimate resolution limit at user supplied sigma level.
SUBROUTINE ESTRES(reslim, sigma)
IMPLICIT NONE
C
C---- real arguments
C
REAL RESLIM, SIGMA
C
C---- include files
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C
C---- Integer scalars
C
INTEGER I
C
C---- Integer arrays
C
INTEGER IBUFF(6)
C
C---- Logicals
C
LOGICAL FULLS
EXTERNAL SPROCESS
C
C---- this is a feeble-minded first attempt to get some useful information
C about the real resolution from the integrated intensities of a single
C image - nothing as sophisticated as Sacha Popov's routines. Use the
C I/sig(I) values for partials if there are no Fullies available.
C
FULLS = .TRUE.
c CALL SPROCESS(-1,IBUFF,.FALSE.,.FALSE.,.FALSE.)
C
C---- fulls must be present in all bins for this to work.
C
DO 100 I=1,9,1
IF(IRESPF(I).EQ.0)THEN
FULLS = .FALSE.
ENDIF
100 ENDDO
IF(FULLS)THEN
C
C---- fulls
C
DO 110 I=1,8,1
IF(FIOVSDS(I).GE.SIGMA)THEN
RESLIM = DBIN(I)
ENDIF
110 ENDDO
WRITE(IOUT,FMT=6000)SIGMA,RESLIM
IF(ONLINE)WRITE(ITOUT,FMT=6000)SIGMA,RESLIM
ELSE
C
C---- partials
C
DO 120 I=1,8,1
IF(PIOVSDS(I).GE.SIGMA)THEN
RESLIM = DBIN(I)
ENDIF
120 ENDDO
WRITE(IOUT,FMT=6010)SIGMA,RESLIM
IF(ONLINE)WRITE(ITOUT,FMT=6010)SIGMA,RESLIM
ENDIF
RETURN
C
C---- Format statements
C
6000 FORMAT('For this image, I/sigma(I) = ',F5.2, ', reflections',
$ ' are here at ',F7.1,' Angstroms resolution (based on',
$ ' FULLS)')
6010 FORMAT('For this image, I/sigma(I) = ',F5.2, ', reflections',
$ ' are here at ',F7.1,' Angstroms resolution (based on',
$ ' PARTIALS)')
END
C== EVAL ==
SUBROUTINE EVAL(OD,MASK,IRAS,PQSUMS,BGSIG,NRMAX,NRBX,MASKREJ,
+ CDEBUG,MODE)
C
IMPLICIT NONE
C
C
C PQSUMS... Background sums, updated by call to BGTEST
C BGSIG.... Determines cutoff level (as multiple of sigma) for
C rejected points
C NRMAX.... Maximum allowed number of rejected background points
C Returned as -999 if this number is exceeded.
C NRBX.... Number of reflections contributing to this box
C Only used to calculate average gradient which is
C used for debug output (NOT for rejection) so this
C number is not critical to operation of S/R.
C MASKREJ.. Returned by this subroutine. The first element contains
C the number of background pixels rejected and is initialised
C to zero and set in BGTEST, the remaining elements
C contain the numbers of the rejected pixels (also
C set in BGTEST).
C CDEBUG.. TRUE if debug is turned on in calling subroutine
C otherwise false. Controls debug ooutput from this S/R
C
C MODE... =0 Do not have information on which background pixels
C may be overlapped by neighbouring spots. In this case
C do search for lowest background pixels over entire
C box.
C =1 Do now have information on which background pixels
C may be overlapped by neighbouring spots so restrict
C search for lowest background pixels over unflagged
C background pixels.
C
C---- This determines the optimum background plane constants, allowing
C for the possibility of adjacent spots intruding into the background
C plane. In the first pass, the background plane is fitted to a
C fraction BGFRAC (set by keyword BACKGROUND subkeyword BGFRAC)
C of the total number of background pixels which have
C the LOWEST pixel values. Using this background, points which
C deviate by more than BGSIG times the expected variation (based
C on counting statistics) are flagged as rejected (BGTEST). The best
C least squares plane is then fitted to the remaining background
C points (BGSOLVE). Because the lowest pixels are selected, this
C will systematically underestimate the value of "c", but this
C is corrected for (assuming a Gaussian distribution) by adding
C a fraction (depending on BGFRAC) of sigma to "c".
C
C Note that when used on an averaged profile, the background has
C already been subtracted. Thus we cannot use counting statistics
C to set the sigma level for rejecting pixels, so use the rms
C variation in the background plane instead. This will not work as
C well because it may be inflated by "bad" pixels. Also we may have
C pixel values less than zero (because the background plane has been
C subtracted, so must allow for this when choosing the NBKGP lowest
C background pixels. These averaged profiles are flagged by having
C a negative BGSIG.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NRMAX,MODE
REAL BGSIG
LOGICAL CDEBUG
C ..
C .. Array Arguments ..
INTEGER IRAS(5)
INTEGER OD(MAXBOX),MASK(MAXBOX),MASKREJ(NREJMAX)
REAL PQSUMS(6)
C ..
C .. Local Scalars ..
REAL A,B,C,SOD,SD,DIFFMAX,DIFFMP,APC,AS,BS,CS,
+ BGMAX,AH,BH,CH,CHDEL,SP,SQ,SPP,SQQ,SPOD,SQOD,APCH,SPQ,
+ SPODH,SQODH,SODH,DET,FAC,RMSBG,DIFF,GRADX,GRADY,BGDEVMAX,
+ DIFFH,SDH
INTEGER HX,HY,IJ,IOD,NXX,NYY,NXY,NOVER,P,Q,NBKG,NREJ,
+ NBKGP,N,IBGCUT,IPNT,IODMIN,IX,IY,JJ,NRBX,I,NDBG,
+ PRANGE,QRANGE,MINP,MAXP,MINQ,MAXQ,MAXPIX
LOGICAL OKPIX
C ..
C .. Local Arrays ..
INTEGER IS(MAXBOX),MASKREJP(NREJMAX),LMASKREJP(NREJMAX)
REAL ABC(3),SPQOD(3),PQ(3,3),PQINV(3,3)
C ..
C .. External Subroutines ..
EXTERNAL BGSOLVE,BGTEST,SORTUP4,ODPLOT4,ODPLOT4R,MINV33,MATVEC
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
COMMON /XYSCAN/ IX,IY
C ..
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(6),SPOD)
EQUIVALENCE (ASPOT(7),SQOD), (ASPOT(8),SOD), (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C), (ASPOT(12),BGDEVMAX)
C
C .. Data statements ..
DATA NDBG/0/
C
MASKREJP(1) = 0
LMASKREJP(1) = 0
C
C To avoid problems with adjacent spots entering background, determine
C the background as the average of the NBKG lowest pixel values
C but excluding thos of zero value (off edge of scan)
C
NXX = IRAS(1)
NYY = IRAS(2)
NXY = NXX*NYY
HX = NXX/2
HY = NYY/2
NBKG = NINT(PQSUMS(6))
C
C Sort pixels into increasing order
CALL SORTUP4(NXY,OD,IS)
C
C---- Loop over bins to find mean background level
C
N = 0
C
C---- Choose a fraction BGFRAC of total number of background points
C
NBKGP = NBKG*BGFRAC
C
C---- Normally exclude pixels outside scanned area (.le.NULLPIX) but
C for averaged standard profiles (flagged by negative BGSIG)
C allow negative values
C
IODMIN = NULLPIX
IF (BGSIG.LT.0) IODMIN = -999999
DO 10 I = 1,NXY
IOD = OD(IS(I))
IF (MODE.EQ.0) THEN
OKPIX = .TRUE.
ELSE
OKPIX = (MASK(IS(I)).LT.0)
END IF
C
C---- Check for pixel outside scanned area
C
IF ((IOD.GT.IODMIN).AND.OKPIX) THEN
N = N + 1
IF (N.GT.NBKGP) GOTO 12
IPNT = I
END IF
10 CONTINUE
N = N + 1
C
12 NBKGP = N - 1
C
C---- Set cutoff level for determination of plane fitting the lowest
C (non-zero) pixels
C
IBGCUT = OD(IS(IPNT))
C
C---- Loop over pixels, form sums for lowest pixels to determine
C new background plane constants
SP = 0.0
SPP = 0.0
SQ = 0.0
SQQ = 0.0
SPQ = 0.0
SPODH = 0.0
SQODH = 0.0
SODH = 0.0
N = 0
IJ = 0
MINP = 999
MINQ = 999
MAXP = -999
MAXQ = -999
C
DO 20 P = -HX,HX
C
C
DO 30 Q = -HY,HY
IJ = IJ + 1
C
C
IOD = OD(IJ)
IF (MODE.EQ.0) THEN
OKPIX = .TRUE.
ELSE
OKPIX = (MASK(IJ).LT.0)
END IF
C
C---- Again, exclude pixels outside scanned area
C
IF ((IOD.GT.IODMIN).AND.(IOD.LE.IBGCUT).AND.OKPIX) THEN
N = N + 1
SPP = P*P + SPP
SP = P + SP
SQQ = Q*Q + SQQ
SQ = Q + SQ
SPQ = P*Q + SPQ
SPODH = P*IOD + SPODH
SQODH = Q*IOD + SQODH
SODH = SODH + IOD
MINP = MIN(MINP,P)
MAXP = MAX(MAXP,P)
MINQ = MIN(MINQ,Q)
MAXQ = MAX(MAXQ,Q)
END IF
30 CONTINUE
20 CONTINUE
SPQOD(1) = SPODH
SPQOD(2) = SQODH
SPQOD(3) = SODH
PQ(1,1) = SPP
PQ(2,2) = SQQ
PQ(3,3) = N
PQ(1,2) = SPQ
PQ(2,1) = SPQ
PQ(1,3) = SP
PQ(3,1) = SP
PQ(2,3) = SQ
PQ(3,2) = SQ
C
C
C ***********************
CALL MINV33(PQINV,PQ,DET)
CALL MATVEC(ABC,PQINV,SPQOD)
C ***********************
C
AH = ABC(1)
BH = ABC(2)
CH = ABC(3)
C
C---- If background has not been determined over a range of at least
C 3 pixels in Y and Y, do not use AH,BH,CH
C
PRANGE = (MAXP-MINP)
QRANGE = (MAXQ-MINQ)
IF ((PRANGE.LE.1).OR.(QRANGE.LE.1)) THEN
AH = A
BH = B
CH = C
END IF
IF ((DEBUG(33).AND.CDEBUG).AND.(NDBG.LT.NDEBUG(33))) THEN
NDBG = NDBG + 1
WRITE(IOUT,FMT=6010) IRAS,PQSUMS,ASPOT,A,B,C,NBKGP,BGSIG,
+ AH,BH,CH,CHDEL,IBGCUT,N,PRANGE,QRANGE
IF (ONLINE) WRITE(ITOUT,FMT=6010) IRAS,PQSUMS,ASPOT,A,B,C,
+ NBKGP,BGSIG,AH,BH,CH,CHDEL,IBGCUT,N,PRANGE,QRANGE
6010 FORMAT(///1X,'In EVAL, IRAS',5I5,/,1X,'PQSUMS',6F12.1,/,1X,
+ 'ASPOT',/,1X,9F12.0,/,1X,9F12.0,/,1X,'A,B,C,NBKGP,BGSIG'
+ ,3F14.1,I8,F5.1,/,1X,'AH,BH,CH,CHDEL,IBGCUT,N',4F14.1,
+ I14,I5,'PRANGE,QRANGE',2I3)
MAXPIX = 0
IF (SPOT) CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
C
C Inflate CH by FAC*sigma(CH) to allow for underestimation caused by
C choosing the lowest pixels. This assumes a normal distribution of
C background counts, which should be adequate except for VERY low
C backgrounds. Note that when dealing with averaged profiles (flagged by
C negative BGSIG) the background has already been subtracted so we cannot
C meaningfully apply this correction.
IF (BGSIG.GT.0.0) THEN
IF (BGFRAC.GE.0.999) THEN
FAC = 0.0
ELSE IF (BGFRAC.GE.0.9) THEN
FAC = 0.05
ELSE IF (BGFRAC.GT.0.7) THEN
FAC = 0.2
ELSE IF (BGFRAC.GT.0.5) THEN
FAC = 0.4
ELSE IF (BGFRAC.GT.0.3) THEN
FAC = 0.6
ELSE
FAC = 0.8
END IF
CHDEL = FAC*SQRT(GAIN*CH)
ELSE
CHDEL = 0.0
END IF
CH = CH + CHDEL
IF ((DEBUG(33).AND.CDEBUG).AND.(NDBG.LT.NDEBUG(33))) THEN
WRITE(IOUT,FMT=6011) CHDEL,CH,FAC
IF (ONLINE) WRITE(ITOUT,FMT=6011) CHDEL,CH,FAC
6011 FORMAT(1X,'Actual CHDEL=',F8.1,' so CH=',F8.1,' FAC=',F5.2)
END IF
C
C Background rejection
C
C
C---- Calculate rms. background residual after plane fitting and
C maximum deviation
C Also calculate the rms deviation for the subset of points used
C in determining the new background plane constants from the lowest
C pixels. Use this rms deviation for rejecting outliers in the case
C of averaged profiles, where we cannot use counting statistics.
SD = 0.0
SDH = 0.0
DIFFMAX = 0.0
DIFFMP = 0.0
IJ = 0
N = 0
C
C
DO 60 P = -HX,HX
APC = A*P + C
APCH = AH*P + CH
C
C
DO 50 Q = -HY,HY
IJ = IJ + 1
C
C
IOD = OD(IJ)
IF ((IOD.GT.IODMIN).AND.(IOD.LE.IBGCUT)) THEN
N = N + 1
DIFFH = IOD - (BH*Q+APCH)
SDH = SDH + DIFFH*DIFFH
END IF
IF (MASK(IJ).LT.0) THEN
DIFF = IOD - (B*Q+APC)
DIFFMP = MAX(DIFFMP,ABS(DIFF))
SD = DIFF*DIFF + SD
C
C Calculate DIFFMAX as maximum difference from the new plane
DIFF = IOD - (BH*Q+APCH)
DIFFMAX = MAX(DIFFMAX,ABS(DIFF))
END IF
C
C
50 CONTINUE
60 CONTINUE
C
C
C
C---- Test maximum deviation from this new plane,reject points and
C recalculate background plane if necessary
C
C---- Must save original plane constants in case no points are rejected
AS = A
BS = B
CS = C
C
C Now set up a the new plane for testing background
A = AH
B = BH
C = CH
C
C---- When profiles have been averaged, the background has already been
C subtracted, so we cannot use the above estimate of BGMAX. In this
C case (which is signalled by a negative value for BGSIG) use the
C rms deviation in the fit of the plane to the lowest pixels
C This will not work quite as well.
C
IF (BGSIG.LT.0.0) THEN
BGSIG = -BGSIG
IF (N.NE.0) BGMAX = BGSIG*SQRT(SDH/REAL(N))
ELSE
BGMAX = BGSIG*SQRT(GAIN*C)
END IF
C
C---- Initialise number of rejected background pixels
C
NREJ = 0
MASKREJ(1) = 0
ASPOT(15) = 0.0
C
IF (DIFFMAX.GT.BGMAX) THEN
C
C---- Plane constants are passed to BGTEST via ASPOT in /SUMS/
C ********************************************************
CALL BGTEST(OD(1),MASK(1),IRAS,MASKREJ(1),PQSUMS(1),BGMAX)
C ********************************************************
C
NREJ = MASKREJ(1)
ASPOT(15) = NREJ
IF ((DEBUG(33).AND.CDEBUG).AND.(NDBG.LT.NDEBUG(33))) THEN
WRITE(IOUT,FMT=6020) PQSUMS,ASPOT,AS,BS,CS,A,B,C,
+ BGMAX,RMSBG,DIFFMAX,NREJ,NRMAX,
+ (MASKREJ(JJ),JJ=2,NREJ+1)
IF (ONLINE) WRITE(ITOUT,FMT=6020) PQSUMS,ASPOT,AS,BS,CS,A,B,
+ C,BGMAX,RMSBG,DIFFMAX,NREJ,NRMAX,
+ (MASKREJ(JJ),JJ=2,NREJ+1)
6020 FORMAT(//,1X,'After BGTEST',/,1X,'PQSUMS',6F12.0,/,1X,
+ 'ASPOT',/,1X,9F12.1,/,1X,9F12.1,/,1X,'Old A,B,C',
+ 3F10.2,/,1X,'New A,B,C',3F10.2,/,1X,'BGMAX, RMSBG,',
+ ' DIFFMAX',3F10.0,/,1X,'NREJ',I5,' NRMAX',I5,/,1X,
+ 'MASKREJ values',(1X,12I5))
END IF
C
C Flag this spots as rejected if too many rejected background points
IF ((DEBUG(33)).AND.(NREJ.GT.100).AND.(CDEBUG)) THEN
WRITE(6,*)'MORE THAN 100 BACKGROUND PIXELS REJECTED'
WRITE(6,*)'PIXEL COORDS',IX,IY
WRITE(6,*)'OLD A,B,C, NEW A,B,C',AS,BS,CS,AH,BH,CH
WRITE(6,*)'IBGCUT,N',IBGCUT,N
WRITE(6,*)'NREJ=,NRMAX=,MASKREJ',NREJ,NRMAX,
+ (MASKREJ(JJ),JJ=2,NREJ+1)
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
IF (NREJ.GT.NRMAX) THEN
NRMAX = -999
RETURN
END IF
END IF
C
C---- Check if too many points rejected to store in MASKREJ
C
IF (NREJ.EQ.-999) THEN
NWRN = NWRN + 1
CAL WRITE (IOUT,FMT=6000) NREJMAX,BGSIG
CAL IF (ONLINE) WRITE (ITOUT,FMT=6000) NREJMAX,BGSIG
6000 FORMAT (//1X,'**** MORE THAN',I5,' BACKGROUND POINTS REJECTED ',
+ ' AS DEVIATING BY MORE THAN',F3.1,'*SIGMA ****',
+ /1X,'Increase BGSIG (keywords BACKGROUND BGSIG)')
ASPOT(15) = 0
NRMAX = -999
RETURN
ELSE IF (NREJ.GT.0) THEN
C
C---- Recalculate background plane
C note that bgsolve updates aspot(3)=rmsbg and aspot(6 to 12)
C (This includes the plane constants)
C ***************************************************
CALL BGSOLVE(OD(1),MASK(1),IRAS,MASKREJ(1),PQSUMS(1))
C ***************************************************
C
C No background points rejected, use original plane constants
ELSE
ASPOT(3) = SQRT(SD/PQSUMS(6))
ASPOT(9) = AS
ASPOT(10) = BS
ASPOT(11) = CS
ASPOT(12) = DIFFMP
END IF
C
GRADX = ABS(ASPOT(9))/NRBX
GRADY = ABS(ASPOT(10))/NRBX
IF ((DEBUG(33)).AND.((GRADX.GT.10.0).OR.(GRADY.GT.10.0))
+ .AND.CDEBUG) THEN
WRITE(6,*)'GRADIENT GREATER THAN 10'
WRITE(6,*)'PIXEL COORDS',IX,IY
WRITE(6,*)'after bgsolve OLD A,B,C, NEW A,B,C',AS,BS,CS,A,B,C
WRITE(6,*)'NREJ=,NRMAX=,MASKREJ',NREJ,NRMAX,
+ (MASKREJ(JJ),JJ=2,NREJ+1)
MAXPIX = 0
CALL ODPLOT4R(OD,NXX,NYY,1,MASK,MASKREJ,MASKREJP,LMASKREJP,
+ MAXPIX)
END IF
IF ((DEBUG(33).AND.CDEBUG).AND.(NDBG.LT.NDEBUG(33))) THEN
WRITE(IOUT,FMT=6030) AS,BS,CS,A,B,C,ASPOT,BGMAX,RMSBG,DIFFMAX
IF (ONLINE) WRITE(ITOUT,FMT=6030) AS,BS,CS,A,B,ASPOT,BGMAX,
+ RMSBG,DIFFMAX
6030 FORMAT(//,1X,'After BGSOLVE',/,1X,'Old A,B,C',
+ 3F14.2,/,1X,'New A,B,C',3F14.2,/,1X,
+ 'ASPOT',/,1X,9F12.1,/,1X,9F12.1,/,1X,'BGMAX, RMSBG,',
+ ' DIFFMAX',3F10.0)
END IF
END
C== EXTRACT ==
C
SUBROUTINE EXTRACT(IODBIG,IRBIG,IRAS,IODPROF)
C =============================================
IMPLICIT NONE
C
C---- Extracts a measurement box of size specified by IRAS from a larger
C box IODBOX size given by IRBIG
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
C ..
C .. Array Arguments ..
INTEGER IODBIG(MAXBOX),IRBIG(2),IRAS(5),IODPROF(MAXBOX)
C ..
C .. Local Scalars ..
REAL A
INTEGER I,J,IJ,IK,IHX,IHY,IHXB,IHYB
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C ..
C ..
C .. Equivalences ..
C
C
SAVE
C .. Data statements ..
C
IHXB = IRBIG(1)/2
IHYB = IRBIG(2)/2
IHX = IRAS(1)/2
IHY = IRAS(2)/2
IJ = 0
IK = 0
C
DO 10 I = -IHXB,IHXB
DO 20 J = -IHYB,IHYB
IJ = IJ + 1
IF ((ABS(I).GT.IHX).OR.(ABS(J).GT.IHY)) GOTO 20
IK = IK + 1
IODPROF(IK) = IODBIG(IJ)
20 CONTINUE
10 CONTINUE
END
C== FEDGE ==
SUBROUTINE FEDGE(IOD1,NP,IMODE,NEDGE)
C ===================================
IMPLICIT NONE
C
C---- Find the position of the boundary between this peak and the neighbouring
C one using pixel values in the 1D array IOD1.
C IMODE = 0 Only need to find significant next peak on one side
C of origin. This is used when called from CENTRS.
C = 1 Need to find significant next peak on both sides
C of origin. This is used when called for standard profiles.
C ..
C .. Scalar Arguments ..
INTEGER NP,NEDGE,IMODE
C ..
C .. Array Arguments ..
INTEGER IOD1(-NP:NP)
C ..
C .. Local Scalars ..
REAL FAC,SIGP,SIGN,DIFFP,DIFFN,X1,X2
INTEGER I,J,IODMIN,IMIN,IODI,IODIM1,IODMI,IODMIP1
LOGICAL POS,NEG
C ..
C .. Local Arrays ..
INTEGER IOD(3)
C ..
C .. External Subroutines ..
EXTERNAL PARAB
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
C
FAC = 5.0
NEDGE = NP
C
C---- Assume the next peak is at least 3 pixels away, so start search
C by comparing pixel +3 with +2, -3 with -2 and work out.
C Sometimes if the initial refinement is not good the centre of
C the spot is not in the middle of the box and since from CENTRS
C a significant peak need only be found on one side this can
C cause problems
C
DO 30 I = 3,NP
IODI = MAX(IOD1(I),0)
IODIM1 = MAX(IOD1(I-1),0)
IODMI = MAX(IOD1(-I),0)
IODMIP1 = MAX(IOD1(-I+1),0)
DIFFP = IODI - IODIM1
DIFFN = IODMI - IODMIP1
SIGP = FAC*0.5*(SQRT(GAIN*IODI)+SQRT(GAIN*IODIM1))
SIGN = FAC*0.5*(SQRT(GAIN*IODMI)+SQRT(GAIN*IODMIP1))
POS = (DIFFP.GT.SIGP)
NEG = (DIFFN.GT.SIGN)
IF (((IMODE.EQ.1).AND.(POS.AND.NEG)).OR.
+ ((IMODE.EQ.0).AND.(POS.OR.NEG))) THEN
C
C---- Found a significant increase, assume this is next peak. Find the real
C minimum using a parabolic 3 point interpolation centred on the minimum
C value.
C
C---- First find the minimum value on positive side
C
IF ((IMODE.EQ.0).AND.(.NOT.POS)) GOTO 10
IODMIN = IOD1(0)
IMIN = 0
DO 2 J = 1,NP
C
C---- Don't go beyond the significant increase point found above
C
IF (J.GT.I) GOTO 2
IF (IOD1(J).LT.IODMIN) THEN
IODMIN = IOD1(J)
IMIN = J
END IF
2 CONTINUE
C
DO 4 J = 1,3
IOD(J) = IOD1(IMIN-2+J)
4 CONTINUE
CALL PARAB(IOD,X1)
IF (DEBUG(47)) THEN
WRITE(IOUT,FMT=6000) IOD,IMIN,X1
IF (ONLINE) WRITE(ITOUT,FMT=6000) IOD,IMIN,X1
6000 FORMAT(1X,' Positive side pixel values',3I10,
+ ' IMIN=',I2,' X1=',F5.2)
END IF
X1 = IMIN + X1
C
C---- Now the negative side
C
10 IF ((IMODE.EQ.0).AND.(.NOT.NEG)) GOTO 16
IODMIN = IOD1(0)
IMIN = 0
DO 12 J = -1,-NP,-1
C
C---- Don't go beyond the significant increase point found above
C
IF (J.LT.-I) GOTO 12
IF (IOD1(J).LT.IODMIN) THEN
IODMIN = IOD1(J)
IMIN = J
END IF
12 CONTINUE
C
DO 14 J = 1,3
IOD(J) = IOD1(IMIN+2-J)
14 CONTINUE
CALL PARAB(IOD,X2)
IF (DEBUG(47)) THEN
WRITE(IOUT,FMT=6002) IOD,IMIN,X2
IF (ONLINE) WRITE(ITOUT,FMT=6002) IOD,IMIN,X2
6002 FORMAT(1X,' Negative side pixel values',3I10,
+ ' IMIN=',I2,' X2=',F5.2)
END IF
X2 = IMIN - X2
X2 = ABS(X2)
C
16 IF (IMODE.EQ.0) THEN
IF (.NOT.NEG) THEN
NEDGE = NINT(X1)
ELSE IF (.NOT.POS) THEN
NEDGE = NINT(X2)
ELSE
NEDGE = NINT(0.5*(X1+X2))
END IF
ELSE
NEDGE = NINT(0.5*(X1+X2))
END IF
RETURN
END IF
30 CONTINUE
END
C== FIDUS ==
SUBROUTINE FIDUS(NFOUND,ITHRESH,NOFID,READCC)
C =============================================
IMPLICIT NONE
C
C
C
C---- Locates the fiducial spots, refines their
C position and calculates the centre of the film
C and the film tilting angle on the drum.
C if the size of the search box for the direct beam (mmdb)
C is non-zero, then the program will locate the direct beam
C and use its position to calculate camera constants ccx,ccy
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER ITHRESH,NFOUND
LOGICAL NOFID,READCC
C ..
C .. Local Scalars ..
REAL COSOMF,CTX,CTY,DELX,DELY,ODMEAN,ODSIG,ODSUM,ODSUMSQ,SINOMF,
+ SOD,SXOD,SYOD,TXFAC,PXCEN,PYCEN
INTEGER CCXS,CCYS,FSTX,FSTY,HFWX,HFWY,I,IB,IE,IER,IFSTX,IFX,IFY,
+ II,ILFLB,ILX,ILY,ISX,ISY,ITHSAVE,IXDB,IYDB,J,JX,K,LB,LBP,
+ LF,LFP,LSTX,LSTY,NCHAR,NGMIN,NOD,NODSUM,NTHRESH,XF,YF,NN,
+ KK,ACTX
LOGICAL DIRECT_BEAM,LINE,REPEAT,SPOTL
CHARACTER STRING*20
C ..
C .. Local Arrays ..
INTEGER DLT(5,2),FPOS(5,2),NODD(5),IODSTOR(5),IBIT(5)
C ..
C .. External Subroutines ..
EXTERNAL CBYTE,RDBLK
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ATAN2,COS,MAX,MIN,REAL,SIGN,SIN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
C
IF (NFID.EQ.0) NFID = 1
IF (DEBUG(4)) THEN
WRITE(IOUT,FMT=6050) NFID,ITHRESH,MMDB,NOFID,READCC
IF (ONLINE) WRITE(ITOUT,FMT=6050) NFID,ITHRESH,MMDB,NOFID,
+ READCC
6050 FORMAT(//,1X,'In FIDUS, NFID=',I3,' ITHRESH=',I6,' MMDB=',
+ I6,' NOFID ',L1,' READCC ',L1)
END IF
C
C---- Fiducial constants in scanner frame
C
DIRECT_BEAM = .FALSE.
C
C
C---- Fiducial box size
C
HFWY = MM*FACT + 0.5
HFWX = HFWY
C
C---- Recording of fiducial spots
C must set TXFAC to allow display of fiducials which will
C have coordinates of up to 175mm for vee films, giving 3500
C raster points at 50 micron scan.
C TXFAC converts scanner pixels to graphics pixels
C
NGMIN = MIN(NGX,NGY)
TXFAC = REAL(NGMIN)/3500.0* (SCNSZ/2)
C
C---- If using NOFID option, go straight to finding direct beam
C
IF (NFID.EQ.0) THEN
COSOMF = COS(OMEGAF)
SINOMF = SIN(OMEGAF)
GO TO 200
END IF
C
C---- Define centre of film (10 micron units)
C
XCENF = NREC*2.5*SCNSZ/2
YCENF = 2*NWORD*2.5*SCNSZ/2
OMEGAF = 0.0
IF (DEBUG(4)) THEN
WRITE (IOUT,FMT=6000) XCENF,YCENF,XTOFRA,OMEGAF,
+ TXFAC
IF (ONLINE) WRITE (ITOUT,FMT=6000) XCENF,YCENF,XTOFRA,OMEGAF,
+ TXFAC
6000 FORMAT (/1X,'XCENF,YCENF Calculated from NREC, NWORD',2I6,/3X,
+ 'XTOFRA After updating for film number in PACK',F8.4,/1X,
+ 'Starting OMEGAF',F8.4,/3X,'TXFAC',F6.3)
END IF
10 CONTINUE
C
C
DO 180 J = 1,NFID
IF (DIRECT_BEAM) GO TO 20
XF = (FSPOS(J,1)+XCENF)*FACT + 0.5
YF = (FSPOS(J,2)+YCENF)*FACT + 0.5
C
C---- Box is always scanned towards centre of film
C
ISX = -SIGN(1,FSPOS(J,1))
FSTX = XF - HFWX*ISX
LSTX = HFWX*ISX + XF
ISY = -SIGN(1,FSPOS(J,2))
FSTY = YF - HFWY*ISY
LSTY = HFWY*ISY + YF
C
C---- Test limits to ensure they are on scanned image
C
IFX = MIN(FSTX,LSTX)
ILX = MAX(FSTX,LSTX)
IFY = MIN(FSTY,LSTY)
ILY = MAX(FSTY,LSTY)
C
C
IF ((IFX.LT.1) .OR. (ILX.GT.NREC) .OR. (IFY.LT.1) .OR.
+ (ILY.GT.IYLEN)) THEN
NWRN = NWRN + 1
IF (ONLINE) WRITE (ITOUT,FMT=6002) IFX,ILX,IFY,ILY
6002 FORMAT (//1X,'Fiducial boxes extend outside scanned film area. P',
+ 'IXEL Coords are',4I6)
WRITE (IOUT,FMT=6002) IFX,ILX,IFY,ILY
STOP
END IF
C
C---- Draw fiducial boxes
C
20 CONTINUE
C
C
30 ACTX = FSTX
SOD = 0.0
SXOD = 0.0
SYOD = 0.0
NOD = 0
NODSUM = 0
ODSUM = 0.0
ODSUMSQ = 0.0
SPOTL = .FALSE.
IF (DEBUG(4)) THEN
WRITE (IOUT,FMT=6004) FSTX,LSTX,FSTY,LSTY,ISX,
+ ISY,ITHRESH
IF (ONLINE) WRITE (ITOUT,FMT=6004) FSTX,LSTX,FSTY,LSTY,ISX,
+ ISY,ITHRESH
6004 FORMAT (1X,'FSTX,LSTX',2I6,5X,'FSTY,LSTY',2I6,' ISX,ISY',2I5,
+ ' ITHRESH',I5)
END IF
C
C---- Search for line of densities above threshold
C
DO 150 K = FSTX,LSTX,ISX
C
C *************
CALL RDBLK(K)
C *************
C
IF (DEBUG(4).AND.(J.EQ.3).AND.(K.EQ.FSTX)) THEN
WRITE(IOUT,6041) J,K
6041 FORMAT(///1X,'FID ',I3,' STRIPE OF ODS',I4)
NN = 0
DO 201 I=1,IYLEN
CALL CBYTE(I)
NN = NN+1
IBIT(NN) = I
IODSTOR(NN) = IBA
IF (MOD(NN,5).EQ.0) THEN
NN = 0
WRITE(IOUT,6040) (IBIT(KK),IODSTOR(KK),KK=1,5)
6040 FORMAT(1X,5(' I=',I5,' IBA=',I5))
END IF
201 CONTINUE
END IF
ACTX = ACTX + ISX
LINE = .FALSE.
LB = FSTY
LF = LSTY
C
C
DO 90 I = FSTY,LSTY,ISY
C
C ********
CALL CBYTE(I)
C ********
C
ODSUM = ODSUM + IBA
ODSUMSQ = REAL(IBA)*REAL(IBA) + ODSUMSQ
NODSUM = NODSUM + 1
IF (IBA.LT.ITHRESH) GO TO 60
IF (LINE) GO TO 80
C
C---- Start of line
C
LINE = .TRUE.
LB = I
IB = LB*TXFAC
JX = ACTX*TXFAC
C
GO TO 80
C
C---- End of line
C
60 IF (.NOT.LINE) GO TO 80
LF = I - ISY
IE = LF*TXFAC
C
C
C
C---- Tests for acceptable line
C
C---- Fid must lie completely within box
C
IF (LB.EQ.FSTY) GO TO 70
C
C---- Max. line length is 7.5mm
C
ILFLB = ABS(LF-LB)
IF (ILFLB.GT.300/SCNSZ) GO TO 70
C
C---- Min. line length is 2 pixels
C
IF (ILFLB.LT.2) GO TO 70
IF (.NOT.SPOTL) GO TO 110
C
C---- Test for overlap with previous line
C
IF (ABS((LBP+LFP)- (LB+LF)).LT.
+ ABS((LF-LB)+ (LFP-LBP))) GO TO 110
70 LINE = .FALSE.
80 CONTINUE
90 CONTINUE
LINE = .FALSE.
C
C---- No line
C
IF (.NOT.SPOTL) GO TO 140
C
C---- Tests for acceptable fid
C fid must lie within box
C
IF (IFSTX.EQ.FSTX) GO TO 100
C
C---- Fid must have area greater than .02mm*2 ie 8*50 micron pixels
C
IF (NOD.LT. (32/ (SCNSZ*SCNSZ))) GO TO 100
GO TO 160
C
C---- Fid rejected
C
100 SPOTL = .FALSE.
SOD = 0.0
SXOD = 0.0
SYOD = 0.0
NOD = 0
GO TO 140
C
C---- line
C
110 LFP = LF
LBP = LB
IF (SPOTL) GO TO 120
IFSTX = K
SPOTL = .TRUE.
120 CONTINUE
C
C
DO 130 I = LB,LF,ISY
C
C ********
CALL CBYTE(I)
C ********
C
NOD = NOD + 1
SOD = SOD + IBA
IF (DEBUG(4)) THEN
WRITE(IOUT,6030) J,K,I,NOD,IBA
IF (ONLINE) WRITE(ITOUT,6030) J,K,I,NOD,IBA
6030 FORMAT(1X,'FID',I2,' IX=',I5,' IY=',I5,' NOD=',I5,
+ ' IBA=',I5)
END IF
SXOD = (ACTX-ISX)*IBA + SXOD
SYOD = IBA*I + SYOD
130 CONTINUE
C
C
140 CONTINUE
150 CONTINUE
C
C---- End of loop over stripes (X loop)
C
C---- Will only get to following code if a spot has NOT been found
C
C
C---- Course of action depends on whether this is a repeat scan already,
C
IF (REPEAT) THEN
REPEAT = .FALSE.
ITHRESH = ITHSAVE
C
C
IF (DIRECT_BEAM) THEN
STRING = 'DIRECT BEAM'
NCHAR = 11
ELSE
STRING = 'FIDUCIAL'
NCHAR = 8
END IF
C
C
IF (ONLINE) WRITE (ITOUT,FMT=6006) STRING(1:NCHAR)
6006 FORMAT (1X,A,' NOT FOUND with threshold at 5 sigma above meanod')
WRITE (IOUT,FMT=6006) STRING(1:NCHAR)
IF (DIRECT_BEAM) GO TO 999
GO TO 170
ELSE
C
C---- Change threshold to meanod+5*sigma and repeat search if this
C is lower than current threshold.
C
ODMEAN = ODSUM/NODSUM
C
C---- Beware !! rounding errors can give negative variance if (due to
C scanning errors ?) all values are identical and g.t. 130
C
ODSIG = (ODSUMSQ/NODSUM-ODMEAN*ODMEAN)
C
C
IF (ODSIG.GT.0.0) THEN
ODSIG = SQRT(ODSIG)
ELSE
ODSIG = 0.0
END IF
C
C
NTHRESH = 5.0*ODSIG + ODMEAN
C
C
IF (NTHRESH.LT.ITHRESH) THEN
C
C---- 5*sigma threshold is lower than previous threshold, go and repeat
C search
C
REPEAT = .TRUE.
ITHSAVE = ITHRESH
ITHRESH = NTHRESH
C
C
IF (DEBUG(4)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6008) ODMEAN,ODSIG
6008 FORMAT (/1X,'ODMEAN and SIGMA for repeat set to ',2F6.1)
WRITE (IOUT,FMT=6008) ODMEAN,ODSIG
END IF
C
C
IF (DIRECT_BEAM) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6010) ITHRESH
6010 FORMAT (/1X,'DIRECT BEAM NOT FOUND, Repeat search with threshold',
+ ' at ',I4)
WRITE (IOUT,FMT=6010) ITHRESH
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6012) J,ITHRESH
6012 FORMAT (/1X,'** FIDUCIAL',I2,' NOT FOUND, Repeat search with thr',
+ 'eshold at ',I4)
WRITE (IOUT,FMT=6012) J,ITHRESH
END IF
C
C
GO TO 30
ELSE
C
C---- Threshold was already less than 5*sigma above mean
C Go on to next fiducial, or return if direct beam
C
IF (DIRECT_BEAM) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6014) ITHRESH,ODMEAN,ODSIG
6014 FORMAT (/1X,'** DIRECT BEAM NOT FOUND Even though threshold of ',
+ I4,/1X,'is less than 5 sigma above the mean od in search ',
+ 'BOX (MEAN=',F5.0,' SIGMA=',F4.1,')')
WRITE (IOUT,FMT=6014) ITHRESH,ODMEAN,ODSIG
GO TO 999
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6016) J,ITHRESH,ODMEAN,ODSIG
6016 FORMAT (/1X,'** FIDUCIAL',I2,' NOT FOUND even though threshold of'
+ ,I4,/1X,'is less than 5 sigma above the mean od in search',
+ ' BOX (MEAN=',F5.0,' SIGMA=',F4.1,')')
WRITE (IOUT,FMT=6016) J,ITHRESH,ODMEAN,ODSIG
GO TO 170
END IF
END IF
END IF
C
C
160 IF (REPEAT) THEN
REPEAT = .FALSE.
ITHRESH = ITHSAVE
END IF
C
C
CTX = SXOD/SOD
CTY = SYOD/SOD
SOD = SOD/NOD
C
C
IF (DIRECT_BEAM) THEN
IXDB = CTX/FACT
IYDB = CTY/FACT
CCXS = IXDB - XCENF
CCYS = IYDB - YCENF
C
C---- Need to convert ccxs,ccys which are w.r.t. scanner coordinate
C frame back to ccx,ccy defined w.r.t. film coordinate frame
C **** NOT ANY MORE ****
CAL CCX = CCXS*COSOMF + CCYS*SINOMF
CAL CCY = -CCXS*SINOMF + CCYS*COSOMF
CCX = CCXS
CCY = CCYS
C
C
PXCEN = 0.01*IXDB
PYCEN = 0.01*IYDB
IF (INVERTX) PXCEN = NREC*RAST - PXCEN
WRITE (IOUT,FMT=6018) PXCEN,PYCEN,0.01*CCX,0.01*CCY
6018 FORMAT (/1X,'Direct beam position located by search: ',2F7.1,
+ /,1X,'Camera constants CCX:',F5.2,' CCY=',F5.2)
IF (ONLINE) WRITE (ITOUT,FMT=6018) PXCEN,PYCEN,
+ 0.01*CCX,0.01*CCY
C
C
GO TO 999
END IF
C
C---- Centre of fiducial spot
C
FPOS(J,1) = CTX/FACT + 0.5
FPOS(J,2) = CTY/FACT + 0.5
C
C---- Shifts from expected positions
C
DLT(J,1) = (CTX-XF)/FACT
DLT(J,2) = (CTY-YF)/FACT
NODD(J) = NOD
NFOUND = NFOUND + 1
170 CONTINUE
180 CONTINUE
C
C---- End of loop over nfid fiducials
C
C
IF (LPRINT(1)) THEN
WRITE (IOUT,FMT=6020)
6020 FORMAT (/' FIDUS NO. X Y DX DY NO. POINTS')
IF (ONLINE) WRITE (ITOUT,FMT=6020)
C
C
DO 190 II = 1,NFOUND
WRITE (IOUT,FMT=6022) II,FPOS(II,1),FPOS(II,2),DLT(II,1),
+ DLT(II,2),NODD(II)
6022 FORMAT (6I8)
IF (ONLINE) WRITE (ITOUT,FMT=6022) II,FPOS(II,1),FPOS(II,2),
+ DLT(II,1),DLT(II,2),NODD(II)
190 CONTINUE
C
C
END IF
C
C---- Return unless all fiducials have been found
C
IF (NFOUND.NE.NFID) GO TO 999
C
C---- Calculate film centre and tilting angle
C both as determined from the measurement and
C as corrected using the camera constants
C
XCENF = (FPOS(1,1)+FPOS(3,1))/2.0 + 0.5
YCENF = (FPOS(1,2)+FPOS(3,2))/2.0 + 0.5
C
C---- OMEGAF=FLOAT(FPOS(3,2)-FPOS(2,2))/(FPOS(3,1)-FPOS(2,1))
C note change in definition of omegaf to enable films
C to be put on scanner with osc axis horizontal rather than
C vertical
C
DELX = REAL(FPOS(3,1)-FPOS(2,1))
DELY = REAL(FPOS(3,2)-FPOS(2,2))
OMEGAF = ATAN2(DELY,DELX)
COSOMF = COS(OMEGAF)
SINOMF = SIN(OMEGAF)
C
C---- Now search for direct beam if required
C
200 DIRECT_BEAM = (MMDB.NE.0)
C
C
IF (DIRECT_BEAM) THEN
C
C---- Skip finding direct beam if READCC specified
C
IF (READCC) THEN
WRITE (IOUT,FMT=6024)
6024 FORMAT (/1X,'** Because READCC has been given, camera constants ',
+ 'will not be estimated from the direct beam position ***')
IF (ONLINE) WRITE (ITOUT,FMT=6024)
GO TO 999
END IF
C
C
HFWX = MMDB*FACT + 0.5
HFWY = HFWX
C
C---- Include input values of CCX,CCY in calculating position
C of direct beam search box centre
C
CAL XF = (CCX*COSOMF+XCENF-CCY*SINOMF)*FACT + 0.5
CAL YF = (CCX*SINOMF+YCENF+CCY*COSOMF)*FACT + 0.5
XF = (CCX + XCENF)*FACT + 0.5
YF = (CCY + YCENF)*FACT + 0.5
FSTX = XF - HFWX
LSTX = XF + HFWX
FSTY = YF - HFWY
LSTY = YF + HFWY
ISX = 1
ISY = 1
GO TO 10
END IF
C
C
999 CONTINUE
C
C
RETURN
C
C---- Format statements
C
END
c find_spots.f
c maintained by G.Winter
c 9th May 2002
c
c This is a subroutine to perform the find spots function, returning
c the list of spots to the socket in the display frame in the event that
c you've connected through a socket. This will require a fairly large
c number of parameters to define the spot search..
c
c
c
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
subroutine find_spots(argc, argv, types, values)
c specification:
c
c 1. Find a list of spots from the image which is in memory - that's all!
c
c
c
c
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/gui.f
c gui.h
c maintained by G.Winter
c 16th April 2002
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c This defines the variables and common blocks which are used by the
c new gui control routine. This will also be used in xdisp and control,
c to switch the new gui on!
c
c
logical gui_switch
integer nargs
parameter (nargs = 200)
common /gui/ gui_switch
C&&*&& end_include ../inc/gui.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/findspots.f
c findspots.f header (include) file
c to pass information about the number of spots found about
c and to store the default parameters...
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c values used to pass the spot finding results
integer fs_found, fs_used, fs_rejected, fs_xmin, fs_xmax,
$ fs_ymin, fs_ymax, fs_separation, fs_pixels
c values used to store the default parameter set
integer fs_thresh, fs_rminsp, fs_rmaxsp, fs_xsplit,
$ fs_ysplit, fs_cutwxmin, fs_cutwxmax, fs_cutwymin,
$ fs_cutwymax, fs_npixmin, fs_xoffset, fs_yoffset
logical fs_radx, fs_rady
common /fndspts/ fs_found, fs_used, fs_rejected, fs_xmin,
$ fs_xmax, fs_ymin, fs_ymax, fs_separation, fs_pixels,
$ fs_thresh, fs_rminsp, fs_rmaxsp, fs_xsplit,
$ fs_ysplit, fs_cutwxmin, fs_cutwxmax, fs_cutwymin,
$ fs_cutwymax, fs_npixmin, fs_xoffset, fs_yoffset,
$ fs_radx, fs_rady
C&&*&& end_include ../inc/findspots.f
external getspots, ccplwc, find_spots_help, lenstr
integer argc, types(nargs), lenstr
character*80 argv(nargs)
character*1024 outline
real values(nargs)
c local variables - used for instance in determining the transformations
c needed to get the spots into the image frame - which will be fun in
c itself
integer theta, invertx, i, id, modesp, lprnt, ierr, ipx, ipy
integer*2 spot_position(NSPOTS)
logical setorientation, boxopen
character*80 word, secondword
setorientation = .false.
lprnt = 1
modesp = 0
c check that the input is either a save, restore or help keyword
if(argc .eq. 2) then
word = argv(2)
call ccplwc(word)
if(word .eq. 'help') then
call find_spots_help
return
else if(word .eq. 'save') then
fs_thresh = thresh
fs_rminsp = rminsp
fs_rmaxsp = rmaxsp
fs_cutwxmin = cutwxmin
fs_cutwxmax = cutwxmax
fs_cutwymin = cutwymin
fs_cutwymax = cutwymax
fs_npixmin = npixmin
fs_xoffset = xoffset
fs_yoffset = yoffset
fs_radx = radx
fs_rady = rady
return
else if(word .eq. 'restore') then
thresh = fs_thresh
rminsp = fs_rminsp
rmaxsp = fs_rmaxsp
cutwxmin = fs_cutwxmin
cutwxmax = fs_cutwxmax
cutwymin = fs_cutwymin
cutwymax = fs_cutwymax
npixmin = fs_npixmin
xoffset = fs_xoffset
yoffset = fs_yoffset
radx = fs_radx
rady = fs_rady
return
end if
end if
i = 2
do while(i .lt. argc)
word = argv(i)
if(word .eq. 'threshold') then
if(types(i + 1) .eq. 2) then
thresh = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'rmin') then
if(types(i + 1) .eq. 2) then
rminsp = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'rmax') then
if(types(i + 1) .eq. 2) then
rmaxsp = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'xsplit') then
if(types(i + 1) .eq. 2) then
xsplit = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'ysplit') then
if(types(i + 1) .eq. 2) then
ysplit = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'split') then
if(types(i + 1) .eq. 2) then
xsplit = nint(values(i + 1))
ysplit = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'xmin') then
if(types(i + 1) .eq. 2) then
cutwxmin = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'ymin') then
if(types(i + 1) .eq. 2) then
cutwymin = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'xmax') then
if(types(i + 1) .eq. 2) then
cutwxmax = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'ymax') then
if(types(i + 1) .eq. 2) then
cutwymax = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'pixels') then
if(types(i + 1) .eq. 2) then
npixmin = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'xoffset') then
if(types(i + 1) .eq. 2) then
if(.not. setorientation) then
xoffset = nint(values(i + 1))
radx = .false.
rady = .true.
setorientation = .true.
else
write(*, *) 'Orientation already set'
end if
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'yoffset') then
if(types(i + 1) .eq. 2) then
if(.not. setorientation) then
yoffset = nint(values(i + 1))
radx = .true.
rady = .false.
setorientation = .true.
else
write(*, *) 'Orientation already set'
end if
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'offset') then
if(types(i + 1) .eq. 2) then
xoffset = nint(values(i + 1))
yoffset = nint(values(i + 1))
else
write(*, *) 'This should be a number ', argv(i + 1)
end if
else if(word .eq. 'orientation') then
if(.not. setorientation) then
secondword = argv(i + 1)
call ccplwc(secondword)
if(secondword .eq. 'parallel') then
radx = .true.
rady = .false.
else
radx = .false.
rady = .true.
end if
setorientation = .true.
else
write(*, *) 'Orientation already set'
end if
end if
i = i + 2
end do
c have hopefully set up the parameters by this stage!
call getspots(modesp, id, lprnt, boxopen, ierr)
write(*, *) nspt, ' spots found'
write(*, *) 'Test - '
write(*, *) 'rejected = ', fs_found, fs_used, fs_rejected,
$ fs_xmin, fs_xmax, fs_ymin, fs_ymax, fs_separation,
$ fs_pixels
1 format('',
$ 'ok',
$ '',i5,'', i5, '',
$ '', i5, '',
$ '', i5, '',
$ '', i5, '',
$ '', i5, '',
$ '', i5, '',
$ '', i5, '',
$ '', i5, '',
$ '')
if(socklo) then
write(outline, fmt=1) fs_found, fs_used, fs_xmin +
$ fs_xmax + fs_ymin + fs_ymax + fs_separation +
$ fs_pixels, fs_xmin, fs_xmax, fs_ymin, fs_ymax,
$ fs_separation, fs_pixels
call write_socket_length(serverfd, lenstr(outline),
$ outline)
do i = 1, nspt
ipx = nint(xspt(i) / rast)
ipy = nint(yspt(i) * yscal / rast)
spot_position(2 * i - 1) = ipx
spot_position(2 * i) = ipy
end do
call write_spots(nspt, serverfd, spot_position)
end if
return
end
subroutine find_spots_help
c some help for the find spots routine
write(*, *) 'find_spots help:'
write(*, *) 'the keywords are threahold, rmin, rmax, xsplit'
write(*, *) 'ysplit, split, xmin, ymin, xmax, ymax, pixels,'
write(*, *) 'xoffset, yoffset, offset, orientation, and have'
write(*, *) 'meaning the same as in the Mosflm documentation'
return
end
C== FINDPACK ==
SUBROUTINE FINDPACK(ID,FILMPLT,NFGEN,JPACK,FORCE,READCC,NOFID,
+ NPACK)
C ==============================================================
C
IMPLICIT NONE
C
C ID pack identifier
C FILMPLT if true, flag the zero level using igflag
C NFGEN number of films in this pack from generate file
C JPACK keeps track of current position in generate file
C FORCE indicates if a 'B' or 'C' film is to be processed
C as an 'A' film.
C READCC if true, reads camera constants and distortion
C parameters from generate file for an "A" film
C NOFID if true, read CCX,CCY,CCOM for A,B, and C films
C This subroutine searches the generate file for film pack ID
C it stores the necessary data from the generate file for
C this pack, ie (IR,IM),X,Y,FLAG
C where FLAG indicates if this spot is to be measured on
C the basis of the intensity on the previous film and MINT
C IPACKREC keeps track of position in generate file in 36
C byte records
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER ID,JPACK,NFGEN,NPACK
LOGICAL FILMPLT,FORCE,NOFID,READCC
C ..
C .. Local Scalars ..
REAL RADEG,PI,DTOR
INTEGER I,IBNEG,IBPOS,IBULGE,IDG,IERR,INT,ISD,ITILT,ITWIST,IVERT,
+ J,K,NC,NFULL,NRX,NRY,NXS,NYS,IROFF,IRMG,IR,IM,IPNT,IMAT,
+ IUMAT,ICELL,ICHECK
LOGICAL SECONDPASS,TESTINT,STORE
C ..
C .. Local Arrays ..
REAL RBUFF(45),RBUF(5)
INTEGER IBUFF(45),IH(3)
INTEGER*2 IBUF(18)
C ..
C .. External Subroutines ..
EXTERNAL QREAD,QSEEK,SHUTDOWN,SETMAT
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (IBUFF,RBUFF)
EQUIVALENCE (IBUF(7),RBUF(1))
C ..
SAVE
C
PI = ATAN(1.0)*4.0
DTOR = PI/180.0
C
IF (DEBUG(3)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) ID,IPACKHEAD,IPACKREC,JPACK,
+ NPACKS,NPACK
6000 FORMAT (//1X,'In FINDPACK, Looking for pack',I4,/1X,'IPACKHEAD=',
+ I6,' IPACKREC=',I6,' JPACK=',I3,' NPACKS=',I3,' NPACK=',I3)
WRITE (IOUT,FMT=6000) ID,IPACKHEAD,IPACKREC,JPACK,NPACKS,NPACK
END IF
C
C
TESTINT = .FALSE.
SECONDPASS = .FALSE.
C
C---- First check that we are not at the end of the generate file,
C ie all packs in the file have been read
C
CAL-- Change next line when allowing multiple SERIAL keywords
C
CAL IF (JPACK.EQ.NPACKS) THEN
IF (JPACK.EQ.NPACK) THEN
C
C---- If this is the first pass through generate file, rewind
C it and try again, otherwise give error
C
IF (SECONDPASS) THEN
WRITE (IOUT,FMT=6012) ID
6012 FORMAT (///2X,'***** ERROR ***** ',/1X,'Cannot find image',I5,
+ ' In this GENERATE FILE',/,1X,'This most commonly occurs',
+ ' when there are two processing jobs using',/,1X,'the ',
+ 'same generate filename. Be absolutely sure to use',
+ ' unique filenames',/,1X,'for the generate file, the ',
+ 'SPOTOD file and the COORDS file (if using SEPARATION ',
+ 'CLOSE)')
IF (ONLINE) WRITE (ITOUT,FMT=6012) ID
ID = -1
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
RETURN
ELSE
SECONDPASS = .TRUE.
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
END IF
END IF
C
C
10 CONTINUE
C
C---- Read the next pack header.. Note that JPACK
C starts at zero, hence need JPACK+1 as index.
C
C ***************************
CALL QREAD(IUNIT,IBUFF,180,IERR)
C ***************************
C
IF (IERR.NE.0) GO TO 50
C
C---- IPACKHEAD is record number of the header of current pack
C
IPACKHEAD = IPACKREC
IPACKREC = IPACKREC + 5
IDG = IBUFF(1)
TOSPT = IBUFF(2)
NFULL = IBUFF(3)
PHIBEG = RBUFF(4)
PHIEND = RBUFF(5)
NFGEN = IBUFF(6)
C
IF (DEBUG(3)) THEN
WRITE (IOUT,FMT=6002) IDG,TOSPT,NFULL,PHIBEG,
+ PHIEND,STARTA,NFGEN,IPACKHEAD,IPACKREC
IF (ONLINE) WRITE (ITOUT,FMT=6002) IDG,TOSPT,NFULL,PHIBEG,
+ PHIEND,STARTA,NFGEN,IPACKHEAD,IPACKREC
6002 FORMAT (1X,'IDG=',I4,' TOSPT=',I5,' NFULL=',I5,' PHIBEG,PHIE',
+ 'ND',2F8.2,' STARTA',L2,/,1X,' NFGEN=',I3,
+ ' IPACKHEAD=',I6,' IPACKREC=',I6)
END IF
C
C---- If processing did not start with the A film, read in
C camera constants from generate file
C (normally these are passed in common).
C Also read these parameters if READCC is true
C
IF ( READCC) THEN
C
C---- Need new code here to read camera constants etc from an ascii file
C
CCX = IBUFF(7)
CCY = IBUFF(8)
CCOM = RBUFF(9)
XTOFRA = RBUFF(10)
CBAR = IBUFF(11)
ITILT = IBUFF(12)
ITWIST = IBUFF(13)
YSCAL = RBUFF(15)
C
C
IF (VEE) THEN
IBNEG = IBUFF(16)
IBPOS = IBUFF(17)
IVERT = IBUFF(18)
ELSE
IBULGE = IBUFF(14)
IF (IMGP) IROFF = IBULGE
END IF
C
C
IF (NOFID) THEN
CCXABC(1) = CCX
CCYABC(1) = CCY
CCOMABC(1) = CCOM
CCXABC(2) = IBUFF(19)
CCYABC(2) = IBUFF(20)
CCOMABC(2) = RBUFF(21)
CCXABC(3) = IBUFF(22)
CCYABC(3) = IBUFF(23)
CCOMABC(3) = RBUFF(24)
END IF
C
C
IF (DEBUG(3)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6006) CCX,CCY,CCOM,XTOFRA,
+ CBAR,YSCAL
6006 FORMAT (1X,'Constants read from pack header in GENERATE FILE',/1X,
+ 'CCX,CCY,CCOM',2I4,F6.3,' XTOFRA',F6.4,' CBAR',I5,' YSC',
+ 'AL',F6.4)
WRITE (IOUT,FMT=6006) CCX,CCY,CCOM,XTOFRA,CBAR,YSCAL
C
C
IF (NOFID) THEN
WRITE (IOUT,FMT=6004) CCXABC,CCYABC,CCOMABC
6004 FORMAT (/1X,'NOFID, CCX FOR A,B,C',3I5,/8X,'CCY',10X,3I5,/8X,'CC',
+ 'OMEGA',6X,3F5.2)
IF (ONLINE) WRITE (ITOUT,FMT=6004) CCXABC,CCYABC,CCOMABC
END IF
C
C
IF (VEE) THEN
WRITE (ITOUT,FMT=6008) IBNEG,IBPOS,ITILT,ITWIST,IVERT
6008 FORMAT (1X,'IBNEG=',I4,' IBPOS=',I4,' ITILT=',I4,' ITWIST=',I4,
+ ' IVERT=',I4)
ELSE
WRITE (ITOUT,FMT=6010) ITILT,ITWIST,IBULGE
6010 FORMAT (2X,'ITILT=',I4,' ITWIST=',I4,' IBULGE=',I4)
END IF
END IF
C
C
IF (VEE) THEN
RADEG = 18000.0/3.14159
VBNEG = IBNEG*FDIST
VBPOS = IBPOS*FDIST
VTILT = ITILT*FDIST/RADEG
VTWIST = ITWIST*FDIST/RADEG
VVERT = IVERT*FDIST
ELSE
TWIST = ITWIST*FDIST
TILT = ITILT*FDIST
BULGE = IBULGE*FDIST
IF (IMGP) ROFF = IROFF
END IF
END IF
C
C
JPACK = JPACK + 1
C
C---- If this is not the correct pack, skip to next pack
C
IF (IDG.NE.ID) THEN
C
C---- Check there are more packs in this file
C
CAL-- Change next line when allowing multiple SERIAL keywords
CAL IF (JPACK.NE.NPACKS) THEN
IF (JPACK.NE.NPACK) THEN
IPACKREC = IPACKREC + TOSPT
C
C **************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C **************************
C
GO TO 10
C
C---- If this is the first pass through generate file, rewind
C it and try again, otherwise give error
C
ELSE IF (SECONDPASS) THEN
GO TO 40
ELSE
SECONDPASS = .TRUE.
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
GO TO 10
END IF
END IF
C
C---- Correct pack found. Store AMAT, missetts, divergences in common blocks
C so they will be written to MTZ file by WRGEN (calling CRYSTHDR)
C
C---- Retrieve AMAT in positions 25-33
IPNT = 24
C
C
DO 22 J = 1,3
DO 20 I = 1,3
IPNT = IPNT + 1
AMAT(I,J) = RBUFF(IPNT)
20 CONTINUE
22 CONTINUE
C
C---- Derive UMAT and cell parameters from AMAT (required for MTZ batch
C headers)
IUMAT = 0
ICELL = 0
IMAT = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C
C---- Retrieve DELPHI in positions 34-36
C
DO 24 I = 1,3
IPNT = IPNT + 1
DELPHI(I) = RBUFF(IPNT)
24 CONTINUE
C
C---- Retrieve ETA, DIVH, DIVV (in degrees) in positions 37-39
C
ETA = 0.5*DTOR*RBUFF(37)
DIVH = 0.5*DTOR*RBUFF(38)
DIVV = 0.5*DTOR*RBUFF(39)
C
C
C Store X,Y,IR,M set INT and SD to -9999
C
C First check that, if READCC is true, that parameters have
C actually been written to generate file by FINDCC, by
C testing that XTOFRA is non-zero.
C
IF (READCC .AND. (XTOFRA.EQ.0.0)) THEN
WRITE (IOUT,FMT=6014)
6014 FORMAT (//1X,'*** FATAL ERROR ***',/1X,'Keyword READCC has been ',
+ 'given, but the value of XTOFRA ',/1X,'Read from the GENE',
+ 'RATE FILE is zero, suggesting that FINDCC has not been u',
+ 'sed')
IF (ONLINE) WRITE (ITOUT,FMT=6014)
CALL SHUTDOWN
ELSE
C
C
DO 30 I = 1,TOSPT
C
C *************************
CALL QREAD(IUNIT,IBUF,36,IERR)
C *************************
C
IF (IERR.NE.0) THEN
GO TO 50
ELSE
IM = IBUF(4)
IR = IBUF(5)
XG(I) = RBUF(1)
YG(I) = RBUF(2)
PHIG(I) = RBUF(3)
PHIWG(I) = RBUF(4)
FRACG(I) = RBUF(5)
IRG(I) = IR
IMG(I) = IM
IF (DEBUG(3) .AND. (I.LE.NDEBUG(3))) THEN
WRITE (IOUT,FMT=6020) I,
+ (IBUF(J),J=1,3),IR,IM,(RBUF(J),J=1,5)
IF (ONLINE) WRITE (ITOUT,FMT=6020) I,
+ (IBUF(J),J=1,3),IR,IM,(RBUF(J),J=1,5)
6020 FORMAT (1X,'Record number',I5,' Indices',3I4,5X,' IR',I4,' IM',
+ I4,' coordinates',2F8.1,' Phi ',F9.3,' Width',F6.3,
+ ' Frac ',F5.3)
END IF
C
C---- set igflag and misymg to zero for this reflection.
C
IGFLAG(I) = 0
MISYMG(I) = 0
C
C---- Also the intensities of the b (and c) films must be set to
C unmeasured (-9999,-9999) in case this is a repeat measurement,
C when the mint selection criterion might be different to that
C in the original measurement. this is done in wrgen.
C
C if not starting with an a film, the intensity and standard
C deviation of the preceeding film must be stored in intg
C and isdg for use in selection of refinement spots in next
C
IF (STARTB) THEN
INT = IBUF(7)
ISD = IBUF(8)
ELSE IF (STARTC) THEN
INT = IBUF(9)
ISD = IBUF(10)
END IF
C
C
IF (.NOT.STARTA) THEN
IF (DEBUG(3) .AND. I.LE.NDEBUG(3)) THEN
WRITE (IOUT,FMT=6022) INT,ISD
IF (ONLINE) WRITE (ITOUT,FMT=6022) INT,ISD
6022 FORMAT (1X,'Intensity and sd stored in INTG and ISDG',2I6)
END IF
C
C---- Check that there is at least one reflection with intensity
C greater then mint, ie that the previous film in pack has
C already been measured, unless this is to be processed as an
C 'a' film
C
IF (INT.GT.MINT) TESTINT = .TRUE.
INTG(I) = INT
ISDG(I) = ISD
END IF
C
C---- Store indices, first testing lt 1000 (actually not a real limit)
C
DO 26 J = 1,3
IF (ABS(IBUF(J)).GT.1000) THEN
WRITE(IOUT,FMT=6001) (IBUF(K),K=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6001) (IBUF(K),K=1,3)
IF (BRIEF) WRITE(IBRIEF,FMT=6001) (IBUF(K),K=1,3)
6001 FORMAT(/,1X,'*** FATAL ERROR ***'/,1X,'Cannot store',
+ ' indices greater than 1000'/,1X,'Indices are',3I5)
CALL SHUTDOWN
END IF
26 CONTINUE
C
DO 28 J = 1,3
IH(J) = IBUF(J)
28 CONTINUE
IHG(I) = IH(1)
IKG(I) = IH(2)
ILG(I) = IH(3)
C
C---- If using filmplt, need to flag the zero layer on film
C CANNOT DO THIS NOW, as IGFLAG is used to determine if a
C reflection has been measured (set to 1 in PROCESS for measured
C reflections and tested for >0 in WRMTZ). As it was,
C these reflections would be classed as measured even if they
C were in fact spatial overlaps.
C
CAL IF (FILMPLT) THEN
CAL IF (IH(JUMPAX).EQ.0) IGFLAG(I) = 10
CAL END IF
END IF
30 CONTINUE
C
C---- Update ipackrec
C
IPACKREC = IPACKREC + TOSPT
C
C
IF (DEBUG(3)) THEN
WRITE (IOUT,FMT=6024) TOSPT,IDG,IPACKREC
6024 FORMAT (/1X,'In FINDPACK',I6,' Reflections stored for PACK',I5,
+ ' IPACKREC now',I6)
IF (ONLINE) WRITE (ITOUT,FMT=6024) TOSPT,IDG,IPACKREC
END IF
C
C---- Check testint (see above) is true
C
IF ((.NOT.STARTA) .AND. (.NOT.TESTINT) .AND. (.NOT.FORCE)) THEN
WRITE (IOUT,FMT=6026)
6026 FORMAT (//1X,'***** NO Intensities on the previous film for this',
+ ' pack are greater then MINT *****',/1X,'Consequently NO ',
+ 'Spots will be found for Refinement',/1X,'Check that the ',
+ 'previous film has really been measured !!',/1X,'Going on',
+ ' to the next film pack (IF PRESENT')
IF (ONLINE) WRITE (ITOUT,FMT=6026)
ID = -2
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
END IF
C
C
RETURN
END IF
40 WRITE (IOUT,FMT=6012) ID
IF (ONLINE) WRITE (ITOUT,FMT=6012) ID
ID = -1
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
RETURN
C
C---- Error handling for qread
C
50 WRITE (IOUT,FMT=6028) IERR
6028 FORMAT (//1X,'***** FATAL ERROR in reading GENERATE FILE *****',
+ /1X,I6,' BYTES transferred in read'
+ ,/,1X,'This most commonly occurs',
+ ' when there are two processing jobs using',/,1X,'the ',
+ 'same generate filename. Be absolutely sure to use',
+ ' unique filenames',/,1X,'for the generate file, the ',
+ 'SPOTOD file and the COORDS file (if using SEPARATION ',
+ 'CLOSE)')
IF (ONLINE) WRITE (ITOUT,FMT=6028) IERR
CALL SHUTDOWN
END
C
C
SUBROUTINE FINDSPOTS(XMM,YMM,RMINFND,RMAXFND,WXMM,WYMM,MINPIX,
+ NSPOT,LPRNT,IERRF)
C ==============================================================
C
C
C
C---- This version includes spot widths in x and y
C
C Scans film for spots within circles of inner radius RMINFND,
C maximum radius RMAXFND centered on XMM,YMM
C Note that YMM should be in "pixel" dimensions (ie NOT corrected by YSCAL)
C Minimum dimensions of spot are given by WXMM and WYMM
C
C Routine returns NSPOT and via common /SPOTS2/ the arrays
C XSPOT,YSPOT,RSPOT,INSPOT,NPIX,IWXSPOT,IWYSPOT
C
C IERRF Error flag
C = 0 No error
C = 1 Too many spots found or too many active spots
C
C The algorithm started off similar to that used by Bob Sweet.
C DEBUG(63) THIS SUBROUTINE
C
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL RMINFND,RMAXFND,WXMM,WYMM,XMM,YMM
INTEGER MINPIX,NSPOT,IERRF
LOGICAL LPRNT
C ..
C .. Local Scalars ..
REAL FINT,FITEMP,FXL,SX,SY,TSUMI,
+ TSUMYI,XSQ,YSQ,XTEMP,YTEMP
INTEGER I,IB,ICENT,IDEL,IE,ILEN,IR,ITEMP,ITMP,
+ IX,IXCT,IXH,IXL,IXSPLIT,IY,IYH,IYL,IYMID,
+ IYPT,IYSPLIT,J,JDX,JDY,NCENT,NP,R1,
+ ITHRESH,NEXCLD
LOGICAL ENDSTRIPE,LINE,LXYEXC,LOVERLAP
C ..
C .. Local Arrays ..
REAL SUMI(MXCENT),SUMXI(MXCENT),SUMYI(MXCENT),
+ BKG(MXCENT)
INTEGER IFLAG(MXCENT),IPT(MXCENT),IXCENT(MXCENT),
+ IXMAX(MXCENT),IXMIN(MXCENT),IYBEG(MXCENT),
+ IYCENT(MXCENT),IYEND(MXCENT),IYMAX(MXCENT),
+ IYMIN(MXCENT),NPIXCENT(MXCENT)
C ..
C .. External Subroutines ..
EXTERNAL CBYTE,RDBLK
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,MIN,NINT,REAL,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C ..
SAVE
C
C
C---- Zero array, used as flag
C
IERRF = 0
DO 10 I = 1,MXCENT
NPIXCENT(I) = 0
10 CONTINUE
C
C---- Calculate limits in pixel units
C
IX = NINT(XMM/RAST)
IY = NINT(YMM/RAST)
C
C---- Limits on X
C
IR = NINT(RMAXFND/RAST)
IXL = MAX(1,IX-IR)
IXH = MIN(NREC,IX+IR)
C
C---- Limits on spot dimensions for split spots
C
IXSPLIT = NINT(WXMM/RAST)
IYSPLIT = NINT(WYMM/RAST)
C
NSPOT = 0
NCENT = 0
NEXCLD = 0
C
C---- Outer loop - Loop over stripes/rows
C
IF (LPRNT) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
END IF
6000 FORMAT (/,1X,'Starting spot search...')
C
C
DO 100 IXCT = IXL,IXH
JDX = IXCT - IX
XSQ = JDX*JDX
C
C ***********
CALL RDBLK(IXCT)
C ***********
C
FXL = REAL(IXCT)
C
C---- Determine limits of this stripe
C
IDEL = NINT(SQRT(REAL(IR*IR-JDX*JDX)))
IYL = MAX(1,IY-IDEL)
IYH = MIN(IYLEN,IY+IDEL)
C
C
LINE = .FALSE.
C
C---- Loop over pixels along stripe and
C find lines of pixels above threshold
C At end of line, add line into active spot or start a new spot
C
NP = -1
C
C
DO 50 IYPT = IYL,IYH
NP = NP + 1
C
C ****************
CALL CBYTE(IYPT)
CAL CALL GETOD(IYPT,IBA)
C ****************
C
JDY = IYPT - IY
YSQ = JDY*JDY
C
C---- Do NOT use NINT here, or can get an index one greater than BGOD was
C determined to, and hence a threshold of zero.
C
R1 = SQRT(XSQ+YSQ)
C
C
IF (R1.EQ.0) THEN
ITHRESH = 0
ELSE
ITHRESH = BGOD(R1)
END IF
C
C
ITEMP = IBA
C
C
IF (.NOT.LINE) THEN
C
C---- No line now or before
C
IF (ITEMP.GT.ITHRESH) THEN
C
C---- (.not.line.and.itemp.gt.ithresh) ! New line
C
LINE = .TRUE.
IB = IYPT
FITEMP = REAL(ITEMP-ITHRESH)
TSUMYI = REAL(IYPT)*FITEMP
TSUMI = FITEMP
IF (DEBUG(63)) THEN
WRITE(IOUT,FMT=6010) IXCT,IYPT,ITEMP,ITHRESH
IF (ONLINE) WRITE(ITOUT,FMT=6010) IXCT,IYPT,ITEMP,
+ ITHRESH
6010 FORMAT(1X,'Start a new line at IX=',I5,' IY=',I5,
+ ' Counts',I6,' Threshold',I5)
END IF
END IF
C
C----! (itemp.le.ithresh)
C
ELSE
C
C---- ! (line)
C
ENDSTRIPE = (IYPT.EQ.IYH)
C
C---- ! End of line
C
IF (ITEMP.LE.ITHRESH .OR. ENDSTRIPE) THEN
LINE = .FALSE.
IE = IYPT - 1
ILEN = IE - IB + 1
IYMID = NINT(TSUMYI/TSUMI)
IF (DEBUG(63)) THEN
WRITE(IOUT,FMT=6020) IXCT,IYPT,IYMID,ILEN
IF (ONLINE) WRITE(ITOUT,FMT=6020) IXCT,IYPT,
+ IYMID,ILEN
6020 FORMAT(1X,'Line ended at IX=',I5,' IY=',I5,
+ ' Y Centroid',I5,' Length',I5)
END IF
C
C---- Inner loop - for this line loop over active spots/centroids
C Complicated test to allow for split spots.
C
C Line is considered to be part of spot if either
C a) current line overlaps with line from previous stripe
C b) or centroid of line (IYMID) lies
C within IYSPLIT of current spot centroid
C
LOVERLAP = .FALSE.
DO 20 ICENT = 1,NCENT
IF(.NOT.LOVERLAP)THEN
J = IPT(ICENT)
C AL IF ((J.LE.0).OR.(J.GT.MXCENT)) WRITE(6,*),'J,NCENT',J,NCENT
ITMP = ABS(IYMID-IYCENT(J))
C
C---- Skip if not overlapping and not within IYSPLIT
C
C HRP 10032000 er - the .and. in the line below was .OR., but
C it seems to find more close spots when it's like
C this.
C
IF (ABS((IYEND(J)+IYBEG(J))- (IE+IB)).LE.
+ ABS((IYEND(J)-IYBEG(J))+ (IE-IB)) .and.
+ ITMP.LE.IYSPLIT) THEN
C
IF (DEBUG(63)) THEN
WRITE(IOUT,FMT=6030) ICENT,J
IF (ONLINE) WRITE(ITOUT,FMT=6030) ICENT,J
6030 FORMAT(1X,'Line belongs to spot',I3,
$ ' in slot',I4)
END IF
C
SUMXI(J) = SUMXI(J) + TSUMI*FXL
SUMYI(J) = SUMYI(J) + TSUMYI
SUMI(J) = SUMI(J) + TSUMI
IXCENT(J) = NINT(SUMXI(J)/SUMI(J))
IYCENT(J) = NINT(SUMYI(J)/SUMI(J))
NPIXCENT(J) = NPIXCENT(J) + ILEN
IYBEG(J) = IB
IYEND(J) = IE
IXMAX(J) = IXCT
IYMIN(J) = MIN(IB,IYMIN(J))
IYMAX(J) = MAX(IE,IYMAX(J))
C
C---- Flag spot if line overlaps search area limits
C
IF (IB.EQ.IYL .OR. ENDSTRIPE) IFLAG(J) = 1
C
LOVERLAP = .TRUE.
C
C---- End of inner loop
C
ENDIF
ENDIF
20 ENDDO
IF(.NOT.LOVERLAP)THEN
C
C---- No active spot for current line - start of new spot
C
NCENT = NCENT + 1
IF (NCENT.GT.MXCENT) THEN
WRITE(IOUT,FMT=6032) MXCENT
6032 FORMAT(1X,'Too many active spots, Maximum is:',I6,
+ ' Increase threshold and rerun')
IF (ONLINE) WRITE(ITOUT,FMT=6032) MXCENT
IERRF = 1
RETURN
END IF
C
C---- Find empty slot in which to store info about this spot
C
DO 30 I = 1,MXCENT
IF (NPIXCENT(I).EQ.0) THEN
IPT(NCENT) = I
GOTO 40
END IF
30 CONTINUE
C
C
40 CONTINUE
C
IF (DEBUG(63)) THEN
WRITE(IOUT,FMT=6040) NCENT,IPT(NCENT)
IF (ONLINE) WRITE(ITOUT,FMT=6040) NCENT,IPT(NCENT)
6040 FORMAT(1X,'Starting new spot number',I5,
$ ' in slot',I4)
END IF
C
J = IPT(NCENT)
NPIXCENT(J) = ILEN
SUMXI(J) = TSUMI*FXL
SUMYI(J) = TSUMYI
SUMI(J) = TSUMI
IYBEG(J) = IB
IYEND(J) = IE
IXCENT(J) = NINT(SUMXI(J)/SUMI(J))
IYCENT(J) = NINT(SUMYI(J)/SUMI(J))
IYMIN(J) = IB
IYMAX(J) = IE
IXMIN(J) = IXCT
IXMAX(J) = IXCT
BKG(J) = ITHRESH
C
C---- Flag spot if strip overlaps search area
C
IF (IB.EQ.IYL .OR. IXCT.EQ.IXL) THEN
IFLAG(J) = 1
ELSE
IFLAG(J) = 0
END IF
ENDIF
C
C---- (.not. loverlap)
C
C
C---- (line.and.itemp.gt.ithresh) ! ongoing line
C
ELSE
FITEMP = REAL(ITEMP-ITHRESH)
TSUMYI = REAL(IYPT)*FITEMP + TSUMYI
TSUMI = TSUMI + FITEMP
END IF
C
C----! (itemp.le.ithresh)
C
END IF
C
C----! (.not.line)
C
50 CONTINUE
C
C---- ! End of loop over pixels
C
C
C
C Loop over active spots and store those that have finished
C
C---- Skip if no active spots
C
IF (NCENT.GT.0) THEN
DO 90 ICENT=1,NCENT
J = IPT(ICENT)
C
C---- Spot is considered to be finished if
C a) No pixels for spot found on last stripe
C b) and current stripe is at least IXSPLIT from centroid
C
C Skip if active or within IXSPLIT
C
IF (IXCT-IXCENT(J).GT.IXSPLIT .AND. IXCT.NE.IXMAX(J)) THEN
C
C---- Reject spot if it contains less than MINPIX pixels
C
IF ((NPIXCENT(J).GE.MINPIX).AND.(IFLAG(J).NE.1))THEN
C
C---- Reject spot if it overlaps limits of search area
C
FINT = SUMI(J)
C
C---- Transform to mm
C
SX = SUMXI(J)*RAST/FINT
SY = SUMYI(J)*RAST/FINT
C
C---- Reject spot if in an excluded area
IF (NXYEXC.GT.0) THEN
LXYEXC = .FALSE.
XTEMP=100.0*SX
IF (INVERTX) XTEMP=FLOAT(NREC)*RAST*100.0-XTEMP
YTEMP=100.0*SY
DO 65 I=1,NXYEXC
IF (XTEMP.GE.XYEXC(1,I).AND.
$ XTEMP.LE.XYEXC(3,I).AND.
$ YTEMP.GE.XYEXC(2,I).AND.
$ YTEMP.LE.XYEXC(4,I))THEN
NEXCLD=NEXCLD+1
LXYEXC = .TRUE.
ENDIF
65 CONTINUE
ENDIF
IF(.NOT.LXYEXC)THEN
C
C---- Store spot if centroid lies within RMAXFND of search box centre
C
R1 = SQRT((XMM-SX)**2+ (YMM-SY)**2)
IF ((R1.LE.RMAXFND).AND.(R1.GE.RMINFND))THEN
NSPOT = NSPOT + 1
C
C WRITE(6,*),'nspot',nspot
C
IF (NSPOT.GT.MXSPOT) THEN
IERRF = 1
WRITE(IOUT,FMT=6100) MXSPOT
6100 FORMAT(/,1X,'Too many spots, Maximum is:',
+ I6,'. Rerun with an increased ',
$ 'threshold.')
IF (ONLINE) WRITE(ITOUT,FMT=6100) MXSPOT
NSPOT = NSPOT - 1
RETURN
END IF
C
C
IF (DEBUG(63)) THEN
WRITE(IOUT,FMT=6050) J,SX,SY,IXMIN(J),
+ IXMAX(J),IYMIN(J),IYMAX(J),NPIXCENT(J)
IF (ONLINE) WRITE(ITOUT,FMT=6050) J,SX,SY,
+ IXMIN(J),IXMAX(J),IYMIN(J),IYMAX(J),
$ NPIXCENT(J)
6050 FORMAT(1X,'Spot finished, slot number',I4,
+ ' centroid',2F8.2,' X pixel limits',
+ 2I5,' Y limits',2I5,
$ ' number of pixels',I6)
END IF
XSPOT(NSPOT) = SX
YSPOT(NSPOT) = SY
INSPOT(NSPOT) = NINT(FINT)
ISDSPOT(NSPOT) = NINT(SQRT(GAIN*(FINT +
$ NPIXCENT(J)*BKG(J))))
RSPOT(NSPOT) = R1
NPIX(NSPOT) = NPIXCENT(J)
IWXSPOT(NSPOT) = (IXMAX(J)-IXMIN(J)+1)
IWYSPOT(NSPOT) = (IYMAX(J)-IYMIN(J)+1)
C
C---- Spot stored or rejected
C Set flag and shuffle IPT down to fill gap in array
C
ENDIF
ENDIF
ENDIF
70 NPIXCENT(J) = 0
NCENT = NCENT - 1
C
C---- Skip if last spot
C
IF (ICENT.LE.NCENT)THEN
DO 80 I = ICENT,NCENT
IPT(I) = IPT(I+1)
80 ENDDO
ENDIF
C
C
ENDIF
90 ENDDO
ENDIF
100 ENDDO
IF (NEXCLD.GT.0) THEN
WRITE (IOUT,6060) NEXCLD
IF (ONLINE) WRITE (ITOUT,6060) NEXCLD
6060 FORMAT (1X,'Number of spots excluded from defined areas:',I8)
ENDIF
C
C---- End of loop on stripes/rows/Y
C
C
RETURN
END
c
c
c
subroutine fitcir(ncirpt, mcirpt, ixycpt, circen, cirrad)
c =========================================================
c
c Fit circle to set of points, no variation in yscale
c
c On entry:
c ncirpt number of points in list
c mcirpt number of accepted points in list (excluding
c deleted points)
c ixycpt(2,ncirpt) pixel coordinates of points: deleted points
c are flagged with ixycrd(1,) = -1000
c
c On exit:
c circen(2) coordinates of centre (mm in scanner coordinates)
c cirrad radius (mm)
c
c 1. Convert point coordinates from pixels (Yms, Zms) to scanner frame
c in mm by multiplying by the pixel size & swapping Y,Z to y,x
c
c 2. Fit mm coordinates to circle, NOT allowing for a scale factor in the
c y direction relative to x
c
c If x, y are vectors of the measured x & y coordinates, then we can
c fit a circle, centre (p,q), radius r, with a relative yscale v
c (ie y*v is the corrected y coordinate in mm). The error vector Eps
c is given by
c
c eps = x**2 + y**2 - 2px - 2qy + p**2 + q**2 - r**2
c ~ ~ ~ ~ ~
c = Rcalc**2 - r**2
c ~
c
c = A s + b
c ~ ~
c
c where A = ( x y 1 ) s = ( -2p )
c ~ ~ ~ ~ ( -2q )
c ( p**2 + q**2 - r**2 )
c b = x**2 + y**2
c ~ ~
c ~
c The least squares solution is given by minimizing eps eps
c ~ ~
c This is a linear least squares in the 3 components of s
c ~ ~
c s = - (AA)**-1 A b
c ~ ~
c ~
c AA = ( Sum x**2 Sum x y Sum x )
c ( Sum x y Sum y**2 Sum y )
c ( Sum x Sum y Sum 1 )
c ~
c Ab = ( Sum x*(x**2 + y**2) )
c ( Sum y*(x**2 + y**2) )
c ( Sum (x**2 + y**2) )
c
implicit none
c
integer ncirpt, mcirpt, ixycpt(2,ncirpt)
real circen(2),cirrad, yscale
c
integer i,j
c
integer MAXCPT
parameter (MAXCPT = 200)
double precision aa(3,3), ab(3), det, param(3)
real xc(MAXCPT), yc(MAXCPT)
real sumx, sumy, sumx2, sumy2, sumxy,
$ sumx2py2, sumxx2py2, sumyx2py2, xd, yd
real x, y, r2, rmsres, eps
integer work1(3), work2(3)
c
C
C--- if only one point, that's the new beam centre
C
IF (MCIRPT .EQ. 1) THEN
CIRRAD = 10.0
CALL PX2XYC(X, Y, IXYCPT(1,1), IXYCPT(2,1))
CIRCEN(1) = X
CIRCEN(2) = Y
RMSRES = 0.0
GOTO 900
ENDIF
if (mcirpt .lt. 3) then
cirrad = -1.0
go to 900
endif
c
sumx = 0.0
sumy = 0.0
sumx2 = 0.0
sumy2 = 0.0
sumxy = 0.0
sumx2py2 = 0.0
sumxx2py2 = 0.0
sumyx2py2 = 0.0
c
c--- Get scanner frame coordinates (ie convert to mm)
do 10, i = 1, ncirpt
if (ixycpt(1,i) .gt. -999) then
call px2xyc(x, y, ixycpt(1,i), ixycpt(2,i))
xc(i) = x
yc(i) = y
sumx = sumx + x
sumy = sumy + y
sumx2 = sumx2 + x*x
sumy2 = sumy2 + y*y
sumxy = sumxy + x*y
sumx2py2 = sumx2py2 + x*x + y*y
sumxx2py2 = sumxx2py2 + x*(x*x + y*y)
sumyx2py2 = sumyx2py2 + y*(x*x + y*y)
endif
10 continue
c
aa(1,1) = sumx2
aa(1,2) = sumxy
aa(1,3) = sumx
aa(2,1) = sumxy
aa(2,2) = sumy2
aa(2,3) = sumy
aa(3,1) = sumx
aa(3,2) = sumy
aa(3,3) = mcirpt
c
ab(1) = -sumxx2py2
ab(2) = -sumyx2py2
ab(3) = -sumx2py2
c
call minvd(aa, 3, det, work1, work2)
if (det .eq. 0.0) then
write (6, '(a)') ' ***FITCIR: singular matrix ***'
return
endif
c aa is now inverse normal matrix
c
c param = aa**-1 * ab
do 20, j = 1, 3
param(j) = 0.0
do 30, i = 1, 3
param(j) = param(j) + aa(j,i) * ab(i)
30 continue
20 continue
c
c param vector = ( -2 p )
c ( -2 q )
c ( p**2 + q**2 - r**2 )
c
c where (p, q) is centre of circle (in mm), radius r (mm)
c
circen(1) = -0.5 * param(1)
circen(2) = -0.5 * param(2)
cirrad = sqrt(circen(1)**2 + circen(2)**2 - param(3))
c
sumx2 = 0.0
c--- Calculate rms residual
do 40, i = 1, ncirpt
if (ixycpt(1,i) .gt. -999) then
eps = sqrt((xc(i) - circen(1))**2 +
$ (yc(i) - circen(2))**2) - cirrad
sumx2 = sumx2 + eps**2
endif
40 continue
rmsres = sqrt(sumx2/float(mcirpt))
c
c--- Display results ----
900 call mxdcpm(ncirpt, mcirpt, circen, cirrad, rmsres)
return
end
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== GENERATE ==
SUBROUTINE GENERATE(MODE,ID,GWRITE,UPDATE,LIMIT,POSTREF,NEWPREF,
+ NFGEN,LOVERLAP,NFULLF)
C =================================================================
IMPLICIT NONE
C
C
C---- This subroutine is called for every image.
C Generate and write out the complete generate file using
C the current orientation.
C It is assumed that the generate file is CORRECTLY positioned
C when this subroutine is called.
C DEBUG(32) this S/R
C
C
C Last modified 6/1/92 for POSTREF ADD option
C
C MODE = 1 Both predict and write the generate file. This will be the
C normal route, and will always be done for batch jobs.
C
C = 2 Predict, but DO NOT write the generate file. This route
C will be taken when using the interactive graphics, because
C cell parameters, orientation etc may be changed leading to
C a new prediction list.
C
C = 3 Don't bother trying to find refinment reflections, but DOES
C write a new generate file.
C
C = 4 For use after calling AUTOMATCH, always repredict and write
C the generate file and also do search for refinement spots.
C
C NFULLF Returned. Number of fully recorded reflections found in
C new reflection list after AUTOMATCH. This determines
C whether or not CENTRS is called again.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER ID,LIMIT,NFGEN,MODE,NFULLF
LOGICAL GWRITE,UPDATE,POSTREF,LOVERLAP,NEWPREF
C ..
C .. Local Scalars ..
REAL CX,CY,DELR,DTOR,PI,RPLUS,SX,SY,T,THETA,THPLUS,X,RFP,
+ XLIMIT
INTEGER I,IDG,IERR,IPNT,J,JJ,K,M,MSPOT,NFIRST,NFOUND,NPAR,
+ NWIDE,NOVRL,IR,IM,IWIDTH,IWMAX,MODERK,IR1,IR2,IS,IE,
$ SUM_NIVB,CNT_NIVB,MED_NIVA,MEA_NIVA,
$ MED_NIVB,MEA_NIVB,IXP,IYP,IBUTTON,L,IJ,NHALF
LOGICAL ALLFOUND,REGEN
CHARACTER*80 LINE
C ..
C .. Local Arrays ..
REAL RBUFF(180),RBUFFP(45),TXRS(62),TYRS(62),RBUFFR(5)
INTEGER IBUFF(180),IBUFFP(45),ITRRS(62),JJH(3),NPART(100)
INTEGER*2 IBUFFR(18),ITEMP(1)
LOGICAL FOUND(62)
C ..
C .. External Subroutines ..
EXTERNAL OVERLAP,QREAD,QSEEK,QWRITE,REEK,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ASIN,ATAN,COS,MAX,SIN,SQRT,TAN
C ..
C .. Extrinsic Functions
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/postchk.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file postchk.h
C---- START of include file postchk.h
C
C DELPHIV stores the missets for the first NADD images only,
C so that once NADD images have been processed their
C refined missets can be saved for writing to the
C summary file.
C
C .. Arrays in Common /POSTCHK/
REAL SDBEAM,SDCELL,SDDELPHI,DELPHIV,SHIFT
LOGICAL FCELL
C
C .. Scalars in Common /POSTCHK/ ..
C ..
REAL PRRES1,PRRES2,RESIDMAX,SDFAC,SHIFTMAX,SHIFTFAC,
+ ANGWIDTH,CELLSHIFT,FRACMIN,FRACMAX,FRCSHIFT
INTEGER PRNS,NREFPR,NADD,NRPT,IPRINTP,NPRMIN
LOGICAL USEBEAM,REFCELL
C ..
C .. Common block /POSTCHK/ ..
COMMON /POSTCHK/ SDBEAM(6),SDCELL(6),SDDELPHI(2*NIMAX),
+ DELPHIV(3*NIMAX),SHIFT(3),PRRES1,PRRES2,RESIDMAX,
+ SDFAC,SHIFTMAX,SHIFTFAC,ANGWIDTH,CELLSHIFT,
$ FRACMIN,FRACMAX,FRCSHIFT,
+ PRNS,NREFPR,NADD,NRPT,IPRINTP,
+ NPRMIN,FCELL(6),USEBEAM,REFCELL
C ..
C
C
C&&*&& end_include ../inc/postchk.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C&&*&& include ../inc/virbat.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C---- include file header for virtual batches in post-refinement
C
INTEGER NIVB,MAGIC,NVIRBAT,NADDMISSET,IVIRBAT
LOGICAL NUPR_INT
COMMON /VIRBAT/ NIVB,MAGIC,NVIRBAT,NADDMISSET,
+ IVIRBAT,NUPR_INT
C&&*&& end_include ../inc/virbat.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C ..
C .. Data
C ..
C .. Equivalences ..
EQUIVALENCE (RBUFF,IBUFF)
EQUIVALENCE (IBUFFP,RBUFFP)
CAL EQUIVALENCE (RBUFFR(1),IBUFFR(7))
EQUIVALENCE (RBUFFR(1),IBUFFR(7))
C ..
SAVE
C
C
XLIMIT = LIMIT
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IR2 = 30*IPAD + 30
C
PI = ATAN(1.0)*4.0
DTOR = PI/180.0
ALLFOUND = .FALSE.
C
C
DO 10 I = 1,62
FOUND(I) = .FALSE.
10 CONTINUE
C
C
DO 20 I = 7,18
IBUFFR(I) = -9999
20 CONTINUE
C
IF (BRIEF) WRITE(IBRIEF,FMT=6019)
6019 FORMAT(1X,'Generating reflection list for this image')
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6020) MODE,POSTREF,IPACKHEAD,2.0*ETA/DTOR,
+ 2.0*DIVH/DTOR,2.0*DIVV/DTOR,DELPHI,NRS,
+ MINDTX,MINDTY,PHIBEG,PHIEND,DSTMAX,DSTMAXS,
+ GWRITE,UPDATE
IF (ONLINE) WRITE(ITOUT,FMT=6020) MODE,POSTREF,IPACKHEAD,
+ 2.0*ETA/DTOR,2.0*DIVH/DTOR,2.0*DIVV/DTOR,DELPHI,NRS,
+ MINDTX,MINDTY,PHIBEG,PHIEND,DSTMAX,DSTMAXS,
+ GWRITE,UPDATE
6020 FORMAT(//1X,'In GENERATE, MODE=',I2,/,1X,
+ ' POSTREF=',L1,' IPACKHEAD',I6,
+ ' ETA,DIVH,DIVV',3F7.3,' DELPHI',3F7.2,' NRS',I3,
+ /,1X,'MINDTX,MINDTY',2I8,' Phibeg,end',2F8.3,/,1X,
+ ' DSTMAX,DSTMAXS',2F12.6,/,1X,'GWRITE ',L1,
+ ' UPDATE ',L1)
END IF
C
C
IPACKHEAD = IPACKREC
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6024) IPACKHEAD,IPACKREC
6024 FORMAT(1X,'Current IPACKHEAD, IPACKREC',2I6)
IF (ONLINE) WRITE(ITOUT,FMT=6024) IPACKHEAD,IPACKREC
END IF
C
IF (MODE.EQ.2) GOTO 52
C
C
C---- Store AMAT, DELPHI, ETA, DIVH, DIVV for the
C PACK header (not genfile header)
C
IBUFFP(1) = ID
RBUFFP(4) = PHIBEG
RBUFFP(5) = PHIEND
IBUFFP(6) = NFGEN
C
C---- Store AMAT in positions 25-33
IPNT = 24
C
C
DO 24 J = 1,3
DO 22 I = 1,3
IPNT = IPNT + 1
RBUFFP(IPNT) = AMAT(I,J)
22 CONTINUE
24 CONTINUE
C
C---- Store DELPHI in positions 34-36
C
DO 26 I = 1,3
IPNT = IPNT + 1
RBUFFP(IPNT) = DELPHI(I)
26 CONTINUE
C
C---- Store ETA, DIVH, DIVV (in degrees) in positions 37-39
C
RBUFFP(37) = 2*ETA/DTOR
RBUFFP(38) = 2*DIVH/DTOR
RBUFFP(39) = 2*DIVV/DTOR
C
C---- Must write pack header even though we don't know number
C of reflections because we want to write reflection records.
C
C
CALL QWRITE(IUNIT,IBUFFP,180)
IPACKREC = IPACKHEAD + 5
C
C
C---- Update variables changed in CONVOLUTE option if flag set, or if
C wavelength has been changed as this is ONLY stored in the file header
C and not in the pack header
C
IF (UPDATE) THEN
IPNT = 22
C
C---- Read generate file header
C
C ***************************
CALL QSEEK(IUNIT,1,1,36)
CALL QREAD(IUNIT,IBUFF,720,IERR)
C ***************************
C
C
C---- Convert to degrees for generate file
C
RBUFF(51) = 2*DIVH/DTOR
RBUFF(52) = 2*DIVV/DTOR
RBUFF(63) = WAVE
RBUFF(65) = 2*ETA/DTOR
C
C---- Always update missetting angles
C
IPNT = 31
C
C
DO 50 I = 1,3
IPNT = IPNT + 1
RBUFF(IPNT) = DELPHI(I)
50 CONTINUE
C
C---- Write out new header
C
C ***********************
CALL QSEEK(IUNIT,1,1,36)
CALL QWRITE(IUNIT,IBUFF,720)
C ***********************
END IF
C
C
52 IF (.NOT.GWRITE) RETURN
C
C---- Headers (genfile or pack) dealt with, now do reflections
C
C---- Assign resolution limit, mosaic spread and divergence. If POSTREF
C is being used, then use values from common block, which for the
C first pack will be those from the genfile header, but for subsequent
C packs will be those from the postrefinement. Otherwise use values
C just written to genfile header
C
C
C---- Set DSTMAX to original value(as it can be changed by CONVOLUTE)
C
DSTMAX = DSTMAXS
C
C---- Calculate the reciprocal sphere radius DSTPL - corresponding to
C a slightly higher resolution to be used in checking overlaps
C on the outside of the picture
C
DELR = MAX(MINDTX,MINDTY)*2.0
THETA = ASIN(DSTMAX/2.0)
T = TAN(2.0*THETA)
C
C
C
IF (VEE) THEN
C
C---- Vee cassette
C
RPLUS = 2.0*XTOFD*T/ (SQRT(3.0)+T) + DELR
THPLUS = ATAN(SQRT(3.0)/ (2.0*XTOFD/RPLUS-1.0))*0.5
ELSE
C
C---- Flat cassette
C
RPLUS = XTOFD*T + DELR
THPLUS = ATAN(RPLUS/XTOFD)*0.5
END IF
C
C
DSTPL = SIN(THPLUS)*2.0
DSTPL2 = DSTPL*DSTPL
C
C---- Initialise RMC matrix - for the X and Y missetting angles.
C Rotation about x and then y
C RMC = PHIY . PHIX
C
SX = SIN(DELPHI(1)*DTOR)
SY = SIN(DELPHI(2)*DTOR)
CX = COS(DELPHI(1)*DTOR)
CY = COS(DELPHI(2)*DTOR)
C
RMC(1,1) = CY
RMC(1,2) = SX*SY
RMC(1,3) = CX*SY
RMC(2,1) = 0.0
RMC(2,2) = CX
RMC(2,3) = -SX
RMC(3,1) = -SY
RMC(3,2) = SX*CY
RMC(3,3) = CX*CY
NSPOT = 0
C
C
IF (DEBUG(32)) THEN
X = 2.0/DTOR
WRITE (IOUT,FMT=6000) ETA*X,DIVH*X,DIVV*X,XTOFD,WAVE,
+ DELPHI,DSTMAX,DSTPL
IF (ONLINE) WRITE (ITOUT,FMT=6000) ETA*X,DIVH*X,DIVV*X,
+ XTOFD,WAVE,DELPHI,DSTMAX,DSTPL
END IF
C
C---- Calculate reflections present
C
MODERK = 0
C ****
CALL REEK(ITEMP(1),MODERK)
C ****
C
C---- Check for overlapping reflexions
C
C *******
IF (.NOT.LOVERLAP) CALL OVERLAP
C *******
C
C
56 MSPOT = 0
NFIRST = 1
NFOUND = 0
NFULLF = 0
NPAR = 0
NFULL = 0
DO 58 I = 1,100
NPART(I) = 0
58 CONTINUE
NWIDE = 0
NOVRL = 0
IWMAX = 0
C
C---- Position generate file ready for writing reflection list
C
C ************************
IF (MODE.NE.2) CALL QSEEK(IUNIT,IPACKREC,1,36)
C ************************
C
C---- Don't need to check for refinement reflections if NRS=0 or if
C MODE=3
C
IF ((NRS.EQ.0).OR.(MODE.EQ.3))
$ ALLFOUND = .TRUE.
C
C
DO 130 I = 1,NSPOT
IR = IRG(I)
IM = IMG(I)
C
C---- Do not write reflections outside dstar or X,Y limits, or within cusp
C (but with rlp still cutting sphere)
C
IF (IR.NE.10 .AND. IR.NE.4 .AND. IR.NE.1) THEN
MSPOT = MSPOT + 1
IF (IM.EQ.0) NFULL = NFULL + 1
IF (IR.EQ.2) NOVRL = NOVRL + 1
C
C---- Count number of reflections with various widths
C
IF (IR.GE.IR1) THEN
IWIDTH = IR/IPAD - 1
IF (IWIDTH.GT.IPAD) IWIDTH = IPAD
IWMAX = MAX(IWMAX,IWIDTH)
NPART(IWIDTH) = NPART(IWIDTH) + 1
END IF
C
C---- Too wide in phi
C
IF (IR.EQ.3) NWIDE = NWIDE + 1
C
JJH(1) = IHG(I)
JJH(2) = IKG(I)
JJH(3) = ILG(I)
DO 60 J = 1,3
IBUFFR(J) = JJH(J)
60 CONTINUE
C
C---- Test this reflection against those used in CENTRS refinement,
C and update generate file pointer RRS. Note that the reflections
C will not necessarily be generated in the same order !
C
IF (.NOT.ALLFOUND) THEN
IF (ABS(XG(I)).LE.XLIMIT .AND.
+ ABS(YG(I)).LE.XLIMIT) THEN
C
C
DO 80 K = NFIRST,NRS
IF (.NOT.FOUND(K)) THEN
C
C
DO 70 J = 1,3
IF (JJH(J).NE.IHKLR(J,K)) GO TO 80
70 CONTINUE
C
C
GO TO 90
END IF
80 CONTINUE
GO TO 120
C
C---- This is a refinement reflection, update pointer
C
90 FOUND(K) = .TRUE.
NFOUND = NFOUND + 1
RRS(K) = MSPOT
C
C---- Count number of fulls found
C
IF (IM.EQ.0) NFULLF = NFULLF + 1
C
C---- Flag any partials with negative record number
C
IF (IM.NE.0) THEN
NPAR = NPAR + 1
RRS(K) = -RRS(K)
END IF
C
C---- Find first reflection in list not yet located
C
DO 100 JJ = NFIRST,NRS
IF (.NOT.FOUND(JJ)) GO TO 110
100 CONTINUE
C
C---- all remaining reflections must have been found
C
ALLFOUND = .TRUE.
GO TO 120
110 NFIRST = JJ
END IF
END IF
C
C
120 IBUFFR(4) = IMG(I)
C
C---- Following restricts IR to max value of 32767.
C
IBUFFR(5) = IRG(I)
RBUFFR(1) = XG(I)
RBUFFR(2) = YG(I)
RBUFFR(3) = PHIG(I)
RBUFFR(4) = PHIWG(I)
RBUFFR(5) = FRACG(I)
PHIG(MSPOT) = PHIG(I)
PHIWG(MSPOT) = PHIWG(I)
FRACG(MSPOT) = FRACG(I)
XG(MSPOT) = XG(I)
YG(MSPOT) = YG(I)
IRG(MSPOT) = IRG(I)
IMG(MSPOT) = IMG(I)
IHG(MSPOT) = IHG(I)
IKG(MSPOT) = IKG(I)
ILG(MSPOT) = ILG(I)
IGFLAG(MSPOT) = 0
MISYMG(MSPOT) = 0
C
C ***********************
IF (MODE.NE.2) CALL QWRITE(IUNIT,IBUFFR,36)
C ***********************
C
IF (DEBUG(32) .AND. (MSPOT.LT.NDEBUG(32))) THEN
IR = IRG(I)
IM = IMG(I)
WRITE (IOUT,FMT=6004) I,MSPOT,(IBUFFR(K),K=1,3),
+ IBUFFR(5),IBUFFR(4),(RBUFFR(K),K=1,5)
IF (ONLINE) WRITE (ITOUT,FMT=6004) I,MSPOT,
+ (IBUFFR(K),K=1,3),
+ IBUFFR(5),IBUFFR(4),(RBUFFR(K),K=1,5)
6004 FORMAT (1X,'I',I5,' IRECG',I5,' Indices',3I4,' IR,IM',2I5,
+ ' XG,YG',2F8.1,' PHI',F8.3,' WIDTH',F8.3,' FRAC',F8.3)
END IF
END IF
130 CONTINUE
C
C
IF ((NRS.EQ.0).OR.(MODE.EQ.3)) GOTO 162
C
IF (NFOUND.NE.NRS) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6006) NFOUND,NRS,NFULLF
WRITE (IOUT,FMT=6006) NFOUND,NRS,NFULLF
C
C---- Set record flag negative for reflections not found, so they will
C be eliminated below from the list.
C
DO 140 I = 1,NRS
IF (.NOT.FOUND(I)) RRS(I) = -ABS(RRS(I))
140 CONTINUE
C
C
END IF
C
C
IF (NPAR.NE.0) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6008) NPAR
WRITE (IOUT,FMT=6008) NPAR
END IF
C
C---- Now eliminate partials or unfound reflections from list
C
DO 150 I = 1,NRS
TXRS(I) = XRS(I)
TYRS(I) = YRS(I)
ITRRS(I) = RRS(I)
150 CONTINUE
C
C
M = 0
C
C
DO 160 I = 1,NRS
IF (ITRRS(I).GE.0) THEN
M = M + 1
XRS(M) = TXRS(I)
YRS(M) = TYRS(I)
RRS(M) = ITRRS(I)
END IF
160 CONTINUE
NRS = M
C
C
162 WRITE (IOUT,FMT=6010) MSPOT,NFULL,(MSPOT-NFULL),NOVRL,
+ NWIDE
IF (ONLINE) WRITE (ITOUT,FMT=6010) MSPOT,NFULL,
+ (MSPOT-NFULL),NOVRL,NWIDE
IF (BRIEF) WRITE (IBRIEF,FMT=6010) MSPOT,NFULL,
+ (MSPOT-NFULL),NOVRL,NWIDE
6010 FORMAT (1X,I6,' Reflections generated:',
+ /,1X,I6,' Fully recorded',/,1X,I6,' Partials',/,1X,I6,
+ ' Overlapped reflections',/,1X,I6,' Too wide in phi')
C
C---- Set warning if not many fully recorded reflections
C
RFP = 1.0
IF (MSPOT.GT.0) RFP = REAL(NFULL)/REAL(MSPOT)
WARN(15) = (((RFP.LT.0.2).AND.(NFULL.LT.100))
+ .OR.(NFULL.LT.60))
C
IS = 2
CNT_NIVB = 0
MED_NIVB = 0
NHALF = (MSPOT-NFULL-NOVRL-NWIDE)/2
DO 170 I = 1,10
IF (IS.GT.IWMAX) GOTO 180
IE = IS + 9
IF (I.EQ.1) IE = 10
IE = MIN(IE,IWMAX)
DO 165 J=IS,IE
CNT_NIVB = CNT_NIVB + NPART(J-1)
C
C---- Check for MEDIAN or twice MAGIC
CAL Eliminate the MAGIC test
C
IF (MED_NIVB.EQ.0)THEN
IF (CNT_NIVB.GE.NHALF) MED_NIVB = J
CAL IF (CNT_NIVB.GE.2*MAGIC)THEN
CAL MED_NIVB = J
CAL ELSE
CAL IF((CNT_NIVB.GE.(MSPOT-NFULL-NOVRL-NWIDE)/2)
CAL $ .AND.
CAL $ (CNT_NIVB.GE.MAGIC))MED_NIVB = J
CAL ENDIF
ENDIF
165 ENDDO
WRITE(IOUT,6011) IS,IE,(NPART(J-1),J=IS,IE)
IF (ONLINE) WRITE(ITOUT,6011) IS,IE,(NPART(J-1),J=IS,IE)
IF (BRIEF) WRITE(IBRIEF,6011) IS,IE,(NPART(J-1),J=IS,IE)
6011 FORMAT (1X,'Number of partials extending over',I3,' to',I4,
+ ' images',/,1X,10I6)
IS = IS + 10
IF (I.EQ.1) IS = 11
170 CONTINUE
C
C---- Check for MEAN
C
180 IF(CNT_NIVB.EQ.0)THEN
IF(ONLINE)THEN
WRITE(ITOUT,*)'There are no reflections suitable',
$ ' for use in post-refinement! Check'
WRITE(ITOUT,*)'your ',
$ 'mosaicity and oscillation width carefully!'
ENDIF
WRITE(IOUT,*)'There are no reflections suitable for',
$ ' use in post-refinement! Check'
WRITE(IOUT,*)'your ',
$ 'mosaicity and oscillation width carefully!'
c call shutdown
ENDIF
IF(ONLINE)THEN
WRITE(ITOUT,*)' THERE ARE ',NSPOT,' REFLECTIONS.'
WRITE(ITOUT,*)'"MEDIAN" " " " " ": ',
$ MED_NIVB,' " '
WRITE(ITOUT,*)' NADD is currently.............',NADD
ENDIF
WRITE(IOUT,*)' THERE ARE ',NSPOT,' REFLECTIONS.'
WRITE(IOUT,*)'"MEDIAN" " " " " ": ',MED_NIVB,
$ ' " '
WRITE(IOUT,*)' NADD is currently.............',NADD
IF (MED_NIVB.GT.NADD) THEN
6210 FORMAT('Too few partials for postrefinement on ',I2,
$ ' images. NADD increased to ',I2)
C---- Must not allow NADD to change during a run so comment this out
CAL NADD = MED_NIVB-1
END IF
NIVB = MED_NIVB
IF(ONLINE)WRITE(ITOUT,*)' NIVB is now...................',
$ NIVB
WRITE(IOUT,*)' NIVB is now...................',NIVB
C
C---- Set warning if not enough partials for post-refinement
C
WARN(26) = (((NPART(1).LT.NPRMIN).OR.(WARN(26)))
+ .AND.POSTREF.AND..NOT.NEWPREF)
C
IF (DEBUG(32)) THEN
WRITE (IOUT,FMT=6012) NSPOT,MSPOT,NFULL,NFOUND,NRS
IF (ONLINE) WRITE (ITOUT,FMT=6012) NSPOT,MSPOT,NFULL,
+ NFOUND,NRS
END IF
C
C---- Write out updated pack header
C
TOSPT = MSPOT
NSPOT = MSPOT
IBUFFP(2) = MSPOT
IBUFFP(3) = NFULL
C
IF (MODE.NE.2) THEN
C ************************
CALL QSEEK(IUNIT,IPACKHEAD,1,36)
CALL QWRITE(IUNIT,IBUFFP,180)
C ************************
C
C---- Now position file at the end of this pack (as WRGEN does after
C writing back camera constants) so that if refinement of this pack
C fails, the file is in the correct place for locating the next pack
C
IPACKREC = IPACKHEAD + 5 + TOSPT
C
C---- Store this position as IRECLAST
C
IRECLAST = IPACKREC
C
C ************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C ************************
END IF
IF (MODE.EQ.2) IRECLAST = IPACKREC
C
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6022) IPACKHEAD,IPACKREC,IRECLAST
6022 FORMAT(1X,'Position generate file at IPACKHEAD=',I6,
+ ' and WRITE UPDATED header ',/,1X,'Then position file ',
+ ' to the end of this pack, IPACKREC=',I6,/,1X,
+ 'IRECLAST is now',I6)
IF (ONLINE) WRITE(ITOUT,FMT=6022) IPACKHEAD,IPACKREC,
+ IRECLAST
END IF
C
RETURN
C
C---- Format statements
C
6000 FORMAT (/1X,'In GENERATE, ETA,DIVH,DIVV (DEG)',3F6.3,' XTOFD,WA',
+ 'VE',F7.1,F6.4,/1X,'DELPHI ',3F8.3,' DSTMAX',F8.5,
+ ' DSTPL',F9.6)
6002 FORMAT (//1X,'*** FATAL ERROR ***',/1X,'First pack in GENERATE F',
+ 'ILE is not the pack being processed',/1X,'Only one pack ',
+ 'per generate file is allowed when pattern matching')
6006 FORMAT (/1X,'Only',I3,' of the',I3,' reflections used in CENTRS ',
+ 'refinement located in new',/,1X,'generate file',/,1X,
+ I3,' of these are fully recorded')
6008 FORMAT (1X,I4,' Partials found in refinement list, they will be ',
+ 'eliminated')
6012 FORMAT (1X,I6,' Reflections calculated in generate of which',I6,
+ ' Written to GENERATE FILE',I6,' fulls',/1X,'NFOUND,NRS',
+ 2I5)
C
C
END
C== GENSORT ==
SUBROUTINE GENSORT(MODE,FORCE,LIMIT,VLIM,NMR,ADDPART,PTMIN,LAST)
C ================================================================
C
IMPLICIT NONE
C This subroutine generates a list of reflections, stored in
C IREC,IX,IY where IREC contains the generate file record number
C and IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). This list is then sorted on the X (slowly
C varying) scanner coordinate. This list is used by SEEKRS to search
C for refinement spots and by MEAS for picking out raster boxes
C from the image for integration.
C *** IMPORTANT *** Note that IX,IY are in 10 micron units rather
C than pixels when used to test for spot overlap (MODE=-1 or -2).
C
C
C MODE = -2 As used by MASKONE, select all reflections and output
C coordinates in 10 micron units to file COORDS
C = -1 As used by MASKIT, select all reflections and output
C coordinates in 10 micron units, NOT pixels.
C = 0 As called by SEEKRS, FULLS only outside LIMITS
C = 1 Measurement mode, all reflections
C = 2 Pattern matching, no limits, include reflections cut off
C at both ends.
C = 3 As 0, but include partials.
C
C = 4 Adding partials mode, for those partials that are present
C on TWO images only, don't output a record if the
C reflection is partial at start of oscillation range and
C write two records (one partial, then one full) for
C partials at end of oscillation range. This list is used
C by MEAS.
C
C = 5 Postrefinement mode. Write two reflections for partials
C at end of oscillation, providing they do not extend over
C more than 2 images. Do not suppress partials at start of
C range. The list is used by MEAS.
C
C = 6 Same as MODE = 2 but as called from AUTOMATCH, avoids
C printing out quite as much.
C
C
C FORCE TRUE if processing a B or C film as an A film, otherwise
C FALSE.
C
C LIMIT Limit for selection of refinement spots from central
C region of image. The absolute value of the coordinate
C must be less than LIMIT (in 10 micron units).
C
C VLIM Limit on Y coordinate for Vee films.
C
C NMR Number of records output by gensort. (Note that when
C adding partials there are two records per reflection).
C
C ADDPART TRUE if adding partials over TWO images, otherwise FALSE
C
C PTMIN If using partials for refinement (and not adding partials)
C then reflections which are at least PTMIN recorded will
C be selected (range 0 to 1.0)
C
C LAST True if this is the last image of a run processed with ADDPART
C or POSTREF. However, when called from MOSFLM with MODE=-2,
C if NEWPREF post-refinement is being used LAST is set FALSE
C for the last image.
C
C Reflection flags (IR) (Set by SPTEST called from DSTAR)
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C
C IGFLAG is set to one for accepted reflections if MODE>0, but if
C GENSORT is called again to deal with "dense" images, note
C that IGFLAG will be reset to zero for all reflections.
C Thus it CANNOT be used to check for acceptable reflections
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL VLIM,PTMIN
INTEGER LIMIT,MODE,NMR
LOGICAL FORCE,ADDPART,LAST
C ..
C .. Local Scalars ..
REAL AM,XC,XCAL,YC,YCAL,XLIMIT,SSINOM0,SCOSOM0,OMEGA0,DTOR
INTEGER I,II,IHMR,IMAX,NC,NFAIL,NFAILY,NRX,NRY,NXS,NYS,
+ VLIMIT,XHIGH,XLOW,YHIGH,YLOW,IFREC,ISREC,IXI,IXJ,J,K,
+ IR,IM,NPRINT,IRMAX,IR1,IR2,SMODE
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
EXTERNAL PXYCALC,SORTUP3,MMTOPX,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/trev.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file trev.h
C---- START of include file trev.h
C
C
C .. Scalars in Common block /TREV/ ..
INTEGER NXMAX,NYMAX
C ..
C .. Common Block /TREV/ ..
COMMON /TREV/NXMAX,NYMAX
C ..
C
C
C&&*&& end_include ../inc/trev.f
C&&*&& include ../inc/modarray.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C bits that should only be accessed in modarray.f
C
C IPARTS = array for the integer parts(Image number, MPART)
C IXYHKL = array to hold the indices (H, K, L)
C FPARTS = array to hold the real parts (I, SIGMAI, FRcalc)
C FXYHKL = array to hold the film co-ordinates in mm & PHIW (X, Y, PHI and
C PHIwidth)
INTEGER IPARTS(4,MGRA,NGRA),IXYHKL(3,MGRA)
REAL FPARTS(MGRA,NGRA),FXYHKL(5,MGRA)
INTEGER IBIG,JBIG,KBIG
INTEGER IXBIG(MGRA),IYBIG(MGRA),IRECBIG(MGRA),NREFBIG
REAL INTENS,SIGINT,FRCALC,PHIWID
INTEGER ITEMP,JTEMP,KTEMP
C&&*&& end_include ../inc/modarray.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
C ..
SAVE
C
DTOR = ATAN(1.0)/45.0
C
C---- Initialise IREC
C
DO 2 I = 1,NREFLS
IREC(I) = 0
2 CONTINUE
C
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IR2 = 30*IPAD + 30
C
NPARTEND = 0
VLIMIT = VLIM
XLIMIT = LIMIT
XLOW = XSCMIN + (NXMAX/2 + 1)
XHIGH = XSCMAX - (NXMAX/2 + 1)
YLOW = NYMAX/2 + 1
YHIGH = IYLEN - (NYMAX/2 + 1)
C
C
IF (DEBUG(16)) THEN
IF (ONLINE) WRITE(ITOUT,110) MODE,XLOW,XHIGH,YLOW,YHIGH,
+ FILM,TOSPT,NSPOT,ADDPART,LAST
WRITE(IOUT,110) MODE,XLOW,XHIGH,YLOW,YHIGH,
+ FILM,TOSPT,NSPOT,ADDPART,LAST
END IF
C
C
NFAILY = 0
NFAIL = 0
NREF = 0
C
C---- Set IRMAX...determines maximum number of images over which a partial
C can lie and still be included in refinement. Default is 2 unless PTMIN is
C less than 0.4, in which case it increases
C
IRMAX = IR2
IF (PTMIN.LE.0.2) THEN
IRMAX = 5*IPAD + 5
ELSE IF (PTMIN.LE.0.3) THEN
IRMAX = 4*IPAD + 4
ELSE IF (PTMIN.LE.0.4) THEN
IRMAX = 3*IPAD + 3
END IF
C
IMAX = TOSPT
IF ((MODE.EQ.2).OR.(MODE.EQ.6)) IMAX = NSPOT
C
C---- If MODE = -2 (writing reflections to COORDS file), must first
C reset OMEGA0 to its value after the detector parameter refinement,
C because CCOM is set to zero in REFRT1, otherwise coords will not
C match those written to the SPOTOD file.
C Need to reset OMEGA0 to OMEGAF+DPSIX+TRUECCOM
C Only do this if CCOMEGA has actually been reset (RESETCCOM flag).
C When using conventional refinement, do not
C apply this correct for the last image as REFRT1 is not called.
C
IF ((MODE.EQ.-2).AND.(RESETCCOM).AND.(.NOT.LAST)) THEN
SSINOM0 = SINOM0
SCOSOM0 = COSOM0
OMEGA0 = (DPSIX + TRUECCOM)*DTOR + OMEGAF
SINOM0 = SIN(OMEGA0)
COSOM0 = COS(OMEGA0)
END IF
C
C---- Loop over reflections in generate file
C
DO 10 I = 1,IMAX
IGFLAG(I) = 0
IR = IRG(I)
IM = IMG(I)
XC = XG(I)
YC = YG(I)
C
C
IF (DEBUG(16).AND.(I.LE.NDEBUG(16))) THEN
IF (ONLINE) WRITE(ITOUT,120) I,XC,YC,IR,IM
WRITE(IOUT,120) I,XC,YC,IR,IM
END IF
C
C---- For pattern matching and predicting reflection overlap, allow
C reflections too wide in phi (IR = 3) and all partials
C
IF (((MODE.EQ.2).OR.(MODE.EQ.6).OR.(MODE.LT.0)).AND.
+ ((IR.EQ.3).OR.(IR.GE.IR1))) GOTO 6
C
C---- For spot masking, include spatial overlaps for list for MASKONE,
C but NOT for MASKIT
C
IF ((MODE.EQ.-2).AND.(IR.EQ.2)) GOTO 6
C
C---- Reject all bad reflections (but allow partials)
C
IF ((IR.GT.0).AND.(IR.LT.IR1)) GOTO 10
C
C---- Test on LIMITS only for MODE = 0,3
C
6 IF ((MODE.EQ.0).OR.(MODE.EQ.3)) THEN
C
C---- The following code is for generating a list for SEEKRS. If
C MODE=0 then only fully recorded are allowed. If MODE=3 then partials
C (on two images only) are allowed. If ADDPART is true, only partials
C over 2 images and at the end of oscillation
C are output (IM.GT.0), otherwise only partials with partiality greater
C than PTMIN (but at either start or end of oscillation).
C
IF (IM.NE.0.AND.MODE.EQ.0) GOTO 10
C
C---- Even if allowing partials, only allow those on not more than IRMAX/10
C images, where IRMAX is assigned a value which depends on PTMIN
C
IF (IM.NE.0.AND.(IR.GT.IRMAX)) GOTO 10
IF (ADDPART) THEN
IF (IM.LT.0) GOTO 10
ELSE
AM = 0.01*ABS(FLOAT(IM))
IF ((AM.GT.0.00001).AND.(AM.LT.PTMIN)) GOTO 10
END IF
IF(VEE) GOTO 8
IF(ABS(XC).LT.XLIMIT.AND.ABS(YC).LT.XLIMIT) GOTO 10
GOTO 9
8 IF(ABS(XC).LT.VLIMIT.AND.ABS(YC).LT.XLIMIT) GOTO 10
END IF
C
C---- see if spot is below mint
C ** Note next line has been changed.It will now NOT measure
C reflections with intensity on previous film .lt.MINT when
C using BASA or CASA mode.
C
9 IF (FILM.GT.1.AND.INTG(I).LT.MINT.AND..NOT.FORCE)GOTO 10
C
C---- If adding partials, reject partials at start of oscillation range
C if they only span two images (pixel values are added for this class
C of reflection).
C
IF ((MODE.EQ.4).AND.(IR.EQ.IR2)) GOTO 10
C
C
NREF = NREF + 1
C
C---- Must test limits for NREF because extra records are generated when
C doing post-refinement
C
IF (NREF.GT.NREFLS) GOTO 90
C
IF (IM.EQ.0) THEN
IREC(NREF) = I
ELSE
IREC(NREF) = -I
END IF
C
C---- Count partials over 2 images at end of current image for
C use if POSTHOC post-refinement is in use (otherwise this
C is not used). Passed via /REPRT/ to meas
C
IF ((MODE.EQ.1).AND.(IR.EQ.IR1).AND.ADDPART)
+ NPARTEND = NPARTEND + 1
C
C
C
IF (PRECESS) THEN
CALL PXYCALC(XCAL,YCAL,XC,YC)
ELSE
CALL MMTOPX(XCAL,YCAL,XC,YC)
END IF
C
C---- Test X limits
C
IX(NREF) = NINT(XCAL*FACT)
IF(IX(NREF).GT.XLOW.AND.IX(NREF).LT.XHIGH) THEN
C
C---- If calculating spot overlap, change reflection coords to 10 micron
C units
IF (MODE.LT.0) IX(NREF) = NINT(XCAL)
GOTO 7
END IF
NFAIL = NFAIL + 1
NREF = NREF - 1
IF ((MODE.EQ.1).AND.(IR.EQ.IR1).AND.ADDPART)
+ NPARTEND = NPARTEND - 1
GOTO 10
C
C---- test Y limits
C
7 IY(NREF) = NINT(YCAL*FACT)
IF(IY(NREF).GT.YLOW.AND.IY(NREF).LT.YHIGH) THEN
IF (MODE.LT.0) IY(NREF) = NINT(YCAL)
GO TO 20
END IF
NFAILY = NFAILY + 1
NREF = NREF - 1
IF ((MODE.EQ.1).AND.(IR.EQ.IR1).AND.ADDPART)
+ NPARTEND = NPARTEND - 1
GOTO 10
C
C---- flag this as a measured reflection (but NOT when generating list for
C spot overlap masking (MODE = -1,-2)
C
20 IF (MODE.GE.0) IGFLAG(I) = 1
C
IF (DEBUG(16).AND.(NREF.LE.NDEBUG(16))) THEN
WRITE(IOUT,130) NREF,I,XC,YC,IX(NREF),IY(NREF)
IF (ONLINE) WRITE(ITOUT,130) NREF,I,XC,YC,IX(NREF),IY(NREF)
END IF
C
C---- If adding partials (MODE=4), generate a second reflection
C for every partial over 2 images at the end of the oscillation
C range of current image.
C Similarly if using postrefinement (MODE=5).
C
C--- HRP - We want to keep the data for reflections with (IR .ge. IR1) as
C well, for SPROCESS. Following code modified so it still works with
C old-style post-refinement (limited to partials over 2 images only).
C
IF (((MODE.EQ.4).OR.(MODE.EQ.5)).AND.
+ (.NOT.LAST)) THEN
IF (IR.EQ.IR1) THEN
NREF = NREF + 1
C
C---- Must test limits for NREF because extra records are generated when
C doing post-refinement
C
IF (NREF.GT.NREFLS) GOTO 90
NPARTEND = NPARTEND + 1
IREC(NREF) = I
IX(NREF) = IX(NREF-1)
IY(NREF) = IY(NREF-1)
IF (DEBUG(16).AND.(NREF.LE.NDEBUG(16))) THEN
WRITE(IOUT,132) NREF
IF (ONLINE) WRITE(ITOUT,132) NREF
END IF
ENDIF
C
C--- back to old code
C
END IF
C
C End of loop over reflections
10 CONTINUE
C
C---- check that some spots have been found,
C if not set mode = 999 and return
C
IF(NREF.GT.0)GO TO 11
CAL WRITE(IOUT,FMT=1011) NFAIL,NFAILY
CAL IF (ONLINE)WRITE(ITOUT,FMT=1011)
C
C If this is a B or C film being treated as an A film,
C it may be possible
C to find reflections by reducing MINT.
C
IF (FILM.GT.1) THEN
IF (ONLINE) WRITE(ITOUT,FMT=1102) MINT
WRITE(IOUT,FMT=1102) MINT
END IF
C
C
MODE = 999
RETURN
C
C
11 CALL SORTUP3(NREF,IX,IY,IREC)
NMR = NREF
C
C---- Return if list is for detecting spot overlap.
C
IF (MODE.EQ.-1) RETURN
IF (MODE.EQ.-2) THEN
WRITE(ICOORD) NREF
WRITE(ICOORD) (IX(I),IY(I),IREC(I),I=1,NREF)
C
C---- Must now reset OMEGA0
C
IF (RESETCCOM.AND.(.NOT.LAST)) THEN
SINOM0 = SSINOM0
COSOM0 = SCOSOM0
END IF
RETURN
END IF
C
C If adding partials from the next image, or doing postrefinement
C (MODE = 4,5) the partial reflection
C must always come first in the sorted list. This will not necessarily
C happen in SORTUP3, so must check and resort as necessary. Note that
C the summed partials may not even be adjacent...they may occur anywhere
C amongst reflections with the same value of IX
IF (MODE.GE.4) THEN
DO 30 I = 1,NREF-1
IXI = IX(I)
IFREC = ABS(IREC(I))
DO 35 J = I+1,NREF
IXJ = IX(J)
IF (IXJ.NE.IXI) GOTO 30
ISREC = ABS(IREC(J))
IF (ISREC.EQ.IFREC) THEN
C
C---- Pair found, move intervening records up
C
IF (J-I.GT.1) THEN
DO 37 K = J, I+2, -1
IX(K) = IX(K-1)
IY(K) = IY(K-1)
IREC(K) = IREC(K-1)
37 CONTINUE
END IF
IX(I+1) = IX(I)
IY(I+1) = IY(I)
IREC(I) = -IFREC
IREC(I+1) = IFREC
END IF
35 CONTINUE
30 CONTINUE
END IF
IF (DEBUG(16)) THEN
IF ((MODE.EQ.4).OR.(MODE.EQ.5)) THEN
WRITE(IOUT,FMT=6006) NPARTEND
IF (ONLINE) WRITE(ITOUT,FMT=6006) NPARTEND
ELSE
WRITE(IOUT,FMT=6007) NPARTEND
IF (ONLINE) WRITE(ITOUT,FMT=6007) NPARTEND
END IF
6006 FORMAT(/1X,I5,' Partials at end of range duplicated')
6007 FORMAT(/1X,I5,' Partials at end of range')
WRITE(IOUT,FMT=6008) NREF
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREF
6008 FORMAT(1X,I6,' reflections generated in total')
NPRINT = MIN(NREF,NDEBUG(16))
WRITE(IOUT,FMT=6002) NPRINT
IF (ONLINE) WRITE(ITOUT,FMT=6002) NPRINT
6002 FORMAT(1X,'List of first',I5,'sorted reflections IX,IY,IREC')
DO 40 I=1,NPRINT
IF (ONLINE) WRITE(ITOUT,FMT=6004) IX(I),IY(I),IREC(I)
WRITE(IOUT,FMT=6004) IX(I),IY(I),IREC(I)
6004 FORMAT(1X,3I6)
40 CONTINUE
END IF
C
C---- Set IREC(NREF+1) to zero, so that in MEAS the test for a partial
C pair is not accidently true for the last reflection
C
IF (NREF+1.GT.NREFLS) GOTO 90
IREC(NREF+1) = 0
C
IF(NFAIL.GT.0) THEN
NWRN = NWRN + 1
IF ((ONLINE).AND.(MODE.NE.6))WRITE(ITOUT,FMT=75) NFAIL
IF (MODE.NE.6) WRITE(IOUT,FMT=75) NFAIL
END IF
C
C
IF(NFAILY.GT.0) THEN
NWRN = NWRN + 1
IF (MODE.NE.6) WRITE(IOUT,FMT=76) NFAILY
IF ((ONLINE).AND.(MODE.NE.6))WRITE(ITOUT,FMT=76) NFAILY
END IF
C
C
RETURN
C
90 WRITE(IOUT,FMT=6000) NREFLS
IF (ONLINE) WRITE(ITOUT,FMT=6000) NREFLS
6000 FORMAT(//,1X,'***** FATAL ERROR *****'/,1X,'Too many ',
+ 'reflections generated in MEAS (current limit',I6,
+ ')',/,1X,'Change parameter NREFLS and recompile entire',
+ ' program')
CALL SHUTDOWN
C
110 FORMAT(/1X,'In GENSORT,MODE=',I2,' XLOW,XHIGH',2I6,
+ ' YLOW,YHIGH',2I6,' FILM=',I2/1X,'TOSPT=',I5,' NSPOT=',I5,
+ ' ADDPART ',L1,' LAST ',L1)
120 FORMAT(1X,'Reflection',I5,' XC,YC',2F8.1,' IR,IM',2I5)
130 FORMAT(1X,'Selected refl',I6,' with record number',I6,
+ ' has genfile coordinates',2F8.1,' stored coordinates',2I6)
132 FORMAT(1X,'Generated extra refl',I6,' as summed partial')
1011 FORMAT(' No suitable spots found for',
+ 1X,'SEEKRS Refinement',/1X,I6,' Spots outside X Limits',
+ I8,' Spots outside Y limits')
1102 FORMAT(/1X,'It may be possible to find reflections by reducing',
+ ' the value of MINT'/1X,'Current value is',I5)
75 FORMAT(/5X,I6,' Reflections outside scanned limits on X.'/)
76 FORMAT(5X,I6,' Reflections outside scanned limits on Y.'/)
END
C
C
C== GETBIN ==
SUBROUTINE GETBIN(IRECG,ITHBIN,NBIN,DSTSQ)
C
IMPLICIT NONE
C Returns the sin(theta)/lambda bin ITHBIN and (d*)**2 (A**-2)
C for reflection with generate file number IRECG.
C To get real spacing D in angstroms, D = 1.0/sqrt(DSTSQ)
C If IRECG is zero, sets up NBIN bins equally spaced in
C 4*sinsqth/lambdsq limits
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IRECG,ITHBIN,NBIN
REAL DSTSQ
C ..
C .. Local Scalars ..
REAL DMAX,DMIN,STHLMIN,STHLMAX,STH,DTR,STHINC
INTEGER IMAT,IUMAT,ICELL,I,IH,IK,IL,ICHECK
C ..
C .. Local Arrays ..
INTEGER IHKL(7)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL SETMAT,GETHKL
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT,ATAN,COS
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C
SAVE
C
C---- Initialisation
C
IF (IRECG.EQ.0) THEN
DTR = ATAN(1.0)/45.0
DMAX = 1000.0
DMIN = WAVE/DSTMAX
STHLMIN = 1.0/ (DMAX)**2
STHLMAX = 1.0/ (DMIN)**2
C
C---- set up 4*sinsqth/lambdsq limits
C
STHINC = (STHLMAX-STHLMIN)/NBIN
C
C
DO 10 I = 1,NBIN
STH = I*STHINC + STHLMIN
DBIN(I) = SQRT(1.0/STH)
10 CONTINUE
C
C---- If not already done (ie non zero) calculate reciprocal cell
C
IF (RCELL(1).LT.0.0000001) THEN
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 0
C
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
C WRITE(6,*),'CALLED SETMAT'
END IF
C WRITE(6,*),'WAVE,RCELL,DBIN',WAVE,RCELL,DBIN
ELSE
C
C---- This is a reflection, calculate d-spacing and bin number
C ***************
CALL GETHKL(IRECG,IHKL)
C ***************
IH = IHKL(1)
IK = IHKL(2)
IL = IHKL(3)
C
C---- Calculate dstarsq in dimensionless rlu
C
DSTSQ = IH*IH*RCELL(1)*RCELL(1) +IK*IK*RCELL(2)*RCELL(2)
+ +IL*IL*RCELL(3)*RCELL(3) +
+ 2.0*IH*IK*RCELL(1)*RCELL(2)*COS(RCELL(6)*DTR) +
+ 2.0*IK*IL*RCELL(2)*RCELL(3)*COS(RCELL(4)*DTR) +
+ 2.0*IH*IL*RCELL(1)*RCELL(3)*COS(RCELL(5)*DTR)
C
DSTSQ = DSTSQ/(WAVE**2)
ITHBIN = (DSTSQ-STHLMIN)/STHINC + 1
C IF (NREFD.LT.100) WRITE(6,*),'IH,IK,IL,S,WAVE,ITHBIN',IH,IK,IL,
C + DSTSQ,WAVE,ITHBIN
IF (ITHBIN.LT.1) ITHBIN = 1
IF (ITHBIN.GT.NBIN) ITHBIN = NBIN
END IF
END
C== GETBLK ==
SUBROUTINE GETBLK(STRIP,NNBYTE,IBLK,ISWAP,IERR)
C ==============================================
C
IMPLICIT NONE
C
C ISWAP =0 Swap bytes if logical BYTSWAP in /scn/ is true
C =1 Do NOT swap bytes (used when reading header or
C overflow records)
C
C NNBYTE Number of bytes to read
C IBLK For film images (direct access files) the record number
C
C This subroutine reads in a stripe of data into byte array STRIP.
C Because the data is handled as a stream of bytes, it can deal with
C both film data (in bytes) and image plate data (I*2 words)
C For BigEndian machines, the byte order must be swapped for
C image plate data
C
C---- Modify to read extra bytes at end of R-axis records 2/4/92
C
C---- Trap EOF or read error for QIO reads. 18/11/91 A.G.W.L.
C
C---- Changes from Kim to deal with SGI machines...have to use DISKIO
C so use DISKIO for all Unix machines 25/10/91
C
C .. Scalar Arguments ..
INTEGER IBLK,NNBYTE,ISWAP,IERR
C ..
C .. Array Arguments ..
BYTE STRIP(NNBYTE)
C ..
C .. Local Scalars ..
BYTE BT1,EXTRA(296)
INTEGER I,in
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C .. External Functions ..
LOGICAL LITEND,VAXVMS
EXTERNAL LITEND,VAXVMS
C ..
C
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
C
C
C---- Film images are direct access files, while image plate are
C sequential. Hence need different read statements.
C
IF (IMGP) THEN
IF (VAXVMS()) THEN
READ (INOD) STRIP
ELSE
CALL QREAD(INOD,STRIP,NNBYTE,IERR)
IF (IERR.NE.0) GOTO 20
C
C---- For R-AXIS images, need to skip the extra bytes at the end of each
C record which are outside the scanned area (296 for fine image,
C 148 for coarse)
C
IF (MACHINE.EQ.'RAXI') CALL QREAD(INOD,EXTRA,NEXTRA,IERR)
ENDIF
C
C---- If machine has byte order different from machine on which the image was
C written, need to swap bytes. This is determined by looking at the
C image size in the header record. If it is not an accepted size the
C order is swapped, if still not an accepted size an error is given.
C For prototype Mar images with no header record, it is sufficient to
C test byte order on this machine as they are always written on a Vax.
C
IF ((.NOT.BYTSWAP).OR.(ISWAP.EQ.1))RETURN
DO 10 I=1,NNBYTE,2
BT1 = STRIP(I)
STRIP(I) = STRIP(I+1)
STRIP(I+1) = BT1
10 CONTINUE
C
ELSE
C
C---- Film data
C
IF (VAXVMS()) THEN
READ (INOD,REC=IBLK+ICURR)STRIP
ELSE
CALL QSEEK(INOD,(IBLK+ICURR),1,NNBYTE)
CALL QREAD(INOD,STRIP,NNBYTE,IERR)
IF (IERR.NE.0) GOTO 30
ENDIF
END IF
C
RETURN
C
C---- Error in QIO
C
20 WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
6000 FORMAT(//1X,'**** ERROR READING IMAGE FILE ****')
RETURN
30 WRITE(IOUT,FMT=6002) IBLK+ICURR
IF (ONLINE) WRITE(ITOUT,FMT=6002) IBLK+ICURR
6002 FORMAT(//1X,'**** ERROR READING RECORD',I6,' OF IMAGE FILE ****')
END
SUBROUTINE GETBLOCK(NIMAG,NBLOCK)
C =================================
C---- Determines the optimum block size to process a total of NIMAG images
C so that there are not a small number of images in the final block.
C The blocksize should lie between 5 and 15.
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
INTEGER NIMAG,NBLOCK
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER IBLOCK,ISTART,IEND
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
IF (NIMAG.LE.10) THEN
NBLOCK = NIMAG
C
C---- NPRUN can be zero in a STRATEGY run, must never return NBLOCK as zero.
C
IF (NBLOCK.EQ.0) NBLOCK = 10
RETURN
ELSE
ISTART = 7
IEND = 13
DO 10 IBLOCK = ISTART,IEND
IF (MOD(NIMAG,IBLOCK).EQ.0) GOTO 80
10 CONTINUE
DO 20 IBLOCK = ISTART,IEND
IF (MOD(NIMAG,IBLOCK).EQ.(IBLOCK-1)) GOTO 80
20 CONTINUE
DO 30 IBLOCK = ISTART,IEND
IF (MOD(NIMAG,IBLOCK).EQ.(IBLOCK-2)) GOTO 80
30 CONTINUE
END IF
C
NBLOCK = 10
RETURN
C
80 NBLOCK = IBLOCK
END
C== GETBOX ==
SUBROUTINE GETBOX(IX,IY,NXX,NYY,NPBOX)
C
IMPLICIT NONE
C---- Given reflection coordinates IX,IY in PIXELS in the scanner frame
C returns the size of the standard profile NXX,NYY in pixels and the
C number of the standard profile box NPBOX.
C Called by SEEKRS,NEXT,MEAS,PROCESS
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IX,IY,NXX,NYY,NPBOX
C ..
C .. Local Scalars ..
REAL X,Y
INTEGER I,NX,NY
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
X = 0.01*REAL(IX)/FACT
Y = 0.01*REAL(IY)/FACT
C
C---- Find which strip this reflection is in
C
DO 10 I = 1,NXLINE
IF (IX.LT.NINT(FACT*XLINE(I))) THEN
NX = I
GOTO 20
END IF
10 CONTINUE
C
C---- Special case if it equals the final profile line value
C
IF (IX.EQ.NINT(FACT*XLINE(NXLINE))) THEN
NX = NXLINE
GOTO 20
END IF
C
C---- Should never get here
C
WRITE(IOUT,FMT=6000) X,Y,(0.01*XLINE(I),I=1,NXLINE)
WRITE(IOUT,FMT=6001) (0.01*YLINE(I),I=1,NYLINE)
WRITE(IOUT,FMT=6003)
IF (ONLINE) WRITE(ITOUT,FMT=6000) X,Y,(0.01*XLINE(I),I=1,NXLINE)
IF (ONLINE) WRITE(ITOUT,FMT=6001) (0.01*YLINE(I),I=1,NYLINE)
IF (ONLINE) WRITE(ITOUT,FMT=6003)
6000 FORMAT(1X,'*** FATAL ERROR ***',/,1X,
+ 'The spot with coordinates',2F6.1,' mm wrt an origin at lower ',
+ 'left',/,1X,'hand corner of image lies outside currently ',
+ 'defined',
+ ' standard profile areas',/,1X,'The coordinates of the lines ',
+ '(in mm) defining the standard areas are:',/,1X,'In X ',
+ 'direction',9F5.1)
6001 FORMAT(1X,'In Y direction',9F5.1)
6003 FORMAT(1X,'Note that these coordinates MUST include the lines',
+ ' defining the outside edges',/,1X,'of the detector ',
+ '(normally 0 and 180mm for Mar detector)',/,1X,
+ 'These coordinates can be',
+ ' changed using the PROFILE XLINE ',/,1X,
+ 'and PROFILE YLINE keywords')
CALL SHUTDOWN
C
20 DO 30 I = 1,NYLINE
IF (IY.LT.NINT(FACT*YLINE(I))) THEN
NY = I
GOTO 40
END IF
30 CONTINUE
C
C---- Special case if it equals the final profile line value
C
IF (IY.EQ.NINT(FACT*YLINE(NYLINE))) THEN
NY = NYLINE
GOTO 40
END IF
C
C---- Should never get here
C
WRITE(IOUT,FMT=6000) X,Y,(0.01*XLINE(I),I=1,NXLINE)
WRITE(IOUT,FMT=6001) (0.01*YLINE(I),I=1,NYLINE)
WRITE(IOUT,FMT=6003)
IF (ONLINE) WRITE(ITOUT,FMT=6000) X,Y,(0.01*XLINE(I),I=1,NXLINE)
IF (ONLINE) WRITE(ITOUT,FMT=6001) (0.01*YLINE(I),I=1,NYLINE)
IF (ONLINE) WRITE(ITOUT,FMT=6003)
CALL SHUTDOWN
C
C---- NX and NY should both be gt 1
C
40 IF ((NX.EQ.1).OR.(NY.EQ.1)) THEN
WRITE(IOUT,FMT=6000) X,Y,(0.01*XLINE(I),I=1,NXLINE)
WRITE(IOUT,FMT=6001) (0.01*YLINE(I),I=1,NYLINE)
WRITE(IOUT,FMT=6003)
IF (ONLINE) WRITE(ITOUT,FMT=6000) X,Y,(0.01*XLINE(I),I=1,NXLINE)
IF (ONLINE) WRITE(ITOUT,FMT=6001) (0.01*YLINE(I),I=1,NYLINE)
IF (ONLINE) WRITE(ITOUT,FMT=6003)
CALL SHUTDOWN
END IF
C
C---- For the high resolution default case, only want 3 boxes in the
C first and last X stripe for circular scanners, so adjust NY accordingly
C
IF ((HIGHRES).AND.(.NOT.ORTHOG)) THEN
IF ((NX.EQ.2).OR.(NX.EQ.NXLINE)) THEN
IF (NY.EQ.2) NY = 3
IF (NY.EQ.NYLINE) NY = NYLINE - 1
END IF
END IF
C
C---- Assign box number and size
C
NPBOX = (NX-2)*(NYLINE-1) + (NY-1)
IF ((NPBOX.LT.1).OR.(NPBOX.GT.NUMBOX)) THEN
WRITE(6,*)'ERROR IN GETBOX, NPBOX OUTSIDE RANGE,NPBOX',NPBOX
WRITE(6,*)'If PROFILES XLINES, YLINES have been supplied then'
WRITE(6,*)'make sure the values are appropriate for the '
WRITE(6,*)'resolution limit being used.'
WRITE(6,*)'If they are, consult Andrew Leslie'
CALL SHUTDOWN
END IF
C
C---- Check that this is a valid box. Due to rounding errors or changes
C in the refined input beam position, it is possible for a
C reflection to be predicted inside a box that was originally
C defined as non-valid because all 4 corners lay outside the
C resolution limit. This is a rare event but can happen. In this
C case, reassign the box number to the nearest valid box.
C First try lower resolution box in same Y stripe, then next X stripe.
C
IF (.NOT.BOX(NPBOX)) THEN
IF (NY.EQ.2) THEN
NPBOX = NPBOX + 1
IF (BOX(NPBOX)) GOTO 50
END IF
IF (NY.EQ.NYLINE) THEN
NPBOX = NPBOX - 1
IF (BOX(NPBOX)) GOTO 50
END IF
IF (NX.EQ.2) THEN
NPBOX = NPBOX + (NYLINE-1)
IF (BOX(NPBOX)) GOTO 50
END IF
IF (NX.EQ.NXLINE) THEN
NPBOX = NPBOX - (NYLINE-1)
IF (BOX(NPBOX)) GOTO 50
END IF
C
C---- Still have nor found a valid box, change both X and Y
C
IF ((NY.EQ.2).AND.(NX.EQ.2)) THEN
NPBOX = NPBOX + 1 + (NYLINE -1)
IF (BOX(NPBOX)) GOTO 50
END IF
IF ((NY.EQ.NYLINE).AND.(NX.EQ.2)) THEN
NPBOX = NPBOX - 1 + (NYLINE -1)
IF (BOX(NPBOX)) GOTO 50
END IF
IF ((NY.EQ.2).AND.(NX.EQ.NXLINE)) THEN
NPBOX = NPBOX + 1 - (NYLINE -1)
IF (BOX(NPBOX)) GOTO 50
END IF
IF ((NY.EQ.NYLINE).AND.(NX.EQ.NXLINE)) THEN
NPBOX = NPBOX - 1 - (NYLINE -1)
IF (BOX(NPBOX)) GOTO 50
END IF
C
C---- No valid box found
C
WRITE(6,*)'IX,IY,NPBOX,NXX,NYY,NX,NY',
+ IX,IY,NPBOX,NXX,NYY,NX,NY
WRITE(6,*)'ERROR, NON VALID BOX IN GETBOX'
WRITE(6,*)'If PROFILES XLINES, YLINES have been supplied then'
WRITE(6,*)'make sure the values are appropriate for the '
WRITE(6,*)'resolution limit being used.'
WRITE(6,*)'If they are, consult Andrew Leslie'
CALL SHUTDOWN
END IF
C
50 NXX = ISIZE(NPBOX,1)
NYY = ISIZE(NPBOX,2)
RETURN
END
C== GETBYTE ==
C
C
C
SUBROUTINE GETBYTE(N)
C =====================
C
C
C---- Gets n'th byte from integer*2 array bbsave
C and transfers it to iod
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Arrays in Common ..
BYTE BBINT,BBSAVE
BYTE IOD
C ..
C .. Common blocks ..
COMMON /BITS/IOD(4),BBSAVE(2*MAXBOX),BBINT(2*MAXBOX)
C ..
SAVE
C
C
c
c-EL for dec5400/vax8600 in subroutine GETBYTE below
IOD(1) = BBSAVE(N)
c-EB for iris220GTX in subroutine GETBYTE below .. start
c NODD = MOD(N,2)
c IF (NODD.EQ.0) THEN
c IOD(4) = BBSAVE(N-1)
c ELSE
c IOD(4) = BBSAVE(N+1)
c END IF
c-EB for iris220GTX in subroutine GETBYTE .. end of modification
c
C
C
END
C== GETCENT ==
SUBROUTINE GETCENT(IX,IY,ICENBOX,CENTRAL)
C
C---- Given direct beam coordinates IX,IY in PIXELS in the scanner frame
C determine which of the standard profile areas it lies in and
C whether the direct beam is approximately in the middle
C of an area (CENTRAL TRUE) or at one edge (CENTRAL FALSE).
C This information is required for the variable profile fitting,
C because reflections within the central box are treated in a
C special way if the central box is indeed centred on the direct beam.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IX,IY,ICENBOX
LOGICAL CENTRAL
C ..
C .. Local Scalars ..
INTEGER I,NX,NY
REAL XX,DX,YY,DY
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC MIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
C---- Find which strip the direct beam is in
C
DO 10 I = 1,NXLINE
IF (IX.LT.NINT(FACT*XLINE(I))) THEN
NX = I
GOTO 20
END IF
10 CONTINUE
C
C---- Direct beam is off rh edge of image
C
CENTRAL = .FALSE.
NX = NXLINE
C
20 DO 30 I = 1,NYLINE
IF (IY.LT.NINT(FACT*YLINE(I))) THEN
NY = I
GOTO 40
END IF
30 CONTINUE
C
C---- Direct beam is off top edge of image
C
CENTRAL = .FALSE.
NY = NYLINE
C
C---- NX and NY should both be gt 1, otherwise beam is off lh edge or bottom
C
40 IF ((NX.EQ.1).OR.(NY.EQ.1)) THEN
C
C---- Direct beam is off edge of image
C
CENTRAL = .FALSE.
END IF
C
C---- Assign box number
C
IF (NX.EQ.1) THEN
ICENBOX = NY-1
IF (ICENBOX.EQ.0) ICENBOX = 1
RETURN
ELSE IF (NY.EQ.1) THEN
ICENBOX = (NX-2)*(NYLINE-1) + 1
RETURN
ELSE
ICENBOX = (NX-2)*(NYLINE-1) + (NY-1)
END IF
C
IF ((ICENBOX.LT.1).OR.(ICENBOX.GT.NUMBOX)) THEN
WRITE(IOUT,FMT=6000) ICENBOX
6000 FORMAT(1X,'ERROR IN GETCENT,ICENBOX OUTSIDE RANGE,ICENBOX',I4)
CALL SHUTDOWN
END IF
C
C---- Is it central ? Central if distance to nearest boundary in X and Y
C is greater than 0.25*width of box
C
XX = REAL(IX)/FACT
DX = MIN((XLINE(NX) - XX),(XX - XLINE(NX-1)))
YY = REAL(IY)/FACT
DY = MIN((YLINE(NY) - YY),(YY - YLINE(NY-1)))
DX = DX/(XLINE(NX)-XLINE(NX-1))
DY = DY/(YLINE(NY)-YLINE(NY-1))
CENTRAL = ((DX.GT.0.25).AND.(DY.GT.0.25))
RETURN
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== GETHDR ==
SUBROUTINE GETHDR(NOVFL,NRECOVFL,ISTAT)
C
IMPLICIT NONE
C Read the header record (s) from the image file.
C Changed to read R-axis header and determine byte order 18/4/94
C
C NOVFL Number of overflow pixels at end of file
C NRECOVFL Number of records containing overflow pixels
C ISTAT Error status, -1 if error in reading image
C -2 if error in the header information
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM,NHLMAX
PARAMETER (NPARM = 200)
PARAMETER (NHLMAX = 1000)
C ..
C .. Scalar Arguments ..
INTEGER NOVFL,NRECOVFL,ISTAT
C ..
C .. Local Scalars ..
INTEGER I,J,IERR,NXPIXO,NITEM,NNBYTE,ISWAP,NVAL,NSTART,NEND,
+ NCH,NCHAR,NHBYTES,NROWS,I1,I2,K,IAXIS,IORD,IORDO,
+ HIOVER,NHLINES,NTERM,NCH2,ILRECL,NNREC,HSIZED,SUMBYTES,
$ CHECKSUM
CHARACTER LINE*132,KEY*30,BORDER*3,NULINE*1,BORDER2*13,BLNAME*20,
+ BLPHSTART*20,BLPHEND*20,BLPHINC*20,DETNAME*20,DETDIST*20
REAL OSCRNG,HRASTY,BEAMXD,BEAMYD
LOGICAL FIRSTTIME,MAR345,SIMPLE,BEAMSET
C ..
C ..
C .. Local Arrays ..
REAL RHEAD(MAXHEAD),WORK(20)
CHARACTER*1 CHEAD(MAXHEAD*4)
CHARACTER*80 HLINES(NHLMAX)
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Functions ..
INTEGER LENSTR
LOGICAL LITEND,QISNAN
EXTERNAL LITEND,QISNAN,LENSTR
C ..
C .. External Subroutines ..
EXTERNAL GETBLK,SWAPHDR,MPARSE
C
C .. Common blocks ..
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C ..
C .. Equivalences ..
EQUIVALENCE (RHEAD(1),IHEAD(1))
EQUIVALENCE (CHEAD(1),IHEAD(1))
SAVE
ISTAT = 0
C
C---- Turn off byte swapping in GETBLK
C
ISWAP = 1
IF ((MACHINE.EQ.'MAR ').OR.(MACHINE(1:3).EQ.'CCD')) THEN
C
C---- When we first come to read the header, we do not know the record length
C (NBYTE will be zero) so only read the first 100 bytes (25 I*4 words) but
C once the record length is known, read whole record
C
IF (NBYTE.EQ.0) THEN
NNBYTE = 100
ELSE
NNBYTE = NBYTE
END IF
IERR = 0
CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
6004 FORMAT(/,1X,'Error trying to read header record',
+ ' in image file for scanner type:',A,/,1X,
+ 'Check that the file is',
+ ' the correct length')
ISTAT = -1
RETURN
END IF
C
C---- Work out byte order by checking value of NREC
C NITEM is number of words we want to use from header
NITEM = 25
BYTSWAP = .FALSE.
NREC = IHEAD(1)
C
C---- Changes to allow for new Mar345 scanner. First word in header
C is "1234" if this is a Mar345 new format image.
C
IF ((NREC.NE.1200).AND.(NREC.NE.1600).AND.
+ (NREC.NE.1800).AND.(NREC.NE.2000).AND.
+ (NREC.NE.2300).AND.(NREC.NE.2400).AND.
+ (NREC.NE.3000).AND.(NREC.NE.3450).AND.
+ (NREC.NE.1234)) THEN
NXPIXO = NREC
CALL SWAPHDR(IHEAD(1),NITEM)
BYTSWAP = .TRUE.
NREC = IHEAD(1)
IF ((NREC.NE.1200).AND.(NREC.NE.1600).AND.
+ (NREC.NE.1800).AND.(NREC.NE.2000).AND.
+ (NREC.NE.2300).AND.(NREC.NE.2400).AND.
+ (NREC.NE.3000).AND.(NREC.NE.3450).AND.
+ (NREC.NE.1234)) THEN
WRITE(IOUT,FMT=6000) NXPIXO,NREC
IF (ONLINE) WRITE(ITOUT,FMT=6000) NXPIXO,NREC
6000 FORMAT(//1X,' **** FATAL ERROR ****',/,1X,'The number',
+ ' of pixels in the X direction must be 1200, 1600',
+ ', 1800, 2000, 2300, 2400, 3000 or 3450.',
+ /,1X,'The number from the first word of the',
+ ' header record is',I16,/,1X,'with original byte ',
+ 'order or',I16,/,1X,'with swapped byte order',/,1X,
+ 'This should be the number of pixels in X for Mar300',
+ ' scanners or "1234" for Mar345 scanners.',/,1X,
+ 'If this is NOT an image from a Mar Scanner, have ',
+ 'you included the appropriate',/,1X,'SCANNER (or ',
+ 'SITE) keyword ??')
ISTAT = -2
RETURN
END IF
WRITE(IOUT,FMT=6001)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
6001 FORMAT(1X,'Image will be byte swapped')
END IF
MAR345 = (NREC.EQ.1234)
IF (MAR345) THEN
MODEL = 'M345'
NREC = IHEAD(2)
IYLEN = NREC
HRAST = 0.001*IHEAD(7)
HRASTY = 0.001*IHEAD(8)
HWAVE = 0.000001*IHEAD(9)
HDIST = 0.001*IHEAD(10)
HPHIS = 0.001*IHEAD(11)
HPHIE = 0.001*IHEAD(12)
IF((HPHIS.GT.HPHIE).AND.(HPHIS-360.0.LT.HPHIE))
$ THEN
HPHIE = HPHIE + 360.0
ENDIF
ELSE
IYLEN = IHEAD(2)
ILRECL = IHEAD(3)
NNREC = IHEAD(4)
NOVFL = IHEAD(5)
C
C---- Because of a bug in some versions of xips, calculate NRECOVFL from NOVFL
C
NVAL = NREC/4
NRECOVFL = (NOVFL-1)/NVAL + 1
IF (NOVFL.EQ.0) NRECOVFL = 0
C
C---- Check for NaN inheader
C
HWAVE = 0.0
HDIST = 0.0
HPHIS = 0.0
HPHIE = 0.0
C
C---- Image which were collected on a scanner hosted by a VAX, and are then
C processed on a Unix machine, have to be converted by a program
C supplied by Mar. Unfortunately the reals in the header are NOT
C converted correctly and are NOT real numbers !!
C This can be trapped on an Alpha and SGI machines by testing the magnitude
C of HWAVE, which is about E+24 in this case, but has been 0.05 in others !
C
IF (.NOT.QISNAN(RHEAD(20))) HWAVE = RHEAD(20)
IF ((HWAVE.GT.0.2).AND.(HWAVE.LT.2.0)) THEN
IF (.NOT.QISNAN(RHEAD(21))) HDIST = RHEAD(21)
IF (.NOT.QISNAN(RHEAD(22))) HPHIS = RHEAD(22)
IF (.NOT.QISNAN(RHEAD(23))) HPHIE = RHEAD(23)
END IF
END IF
C
C---- Set the pixel size based on image size for old "IMAGE" style
C format for Mar345 scanners
C
IF (.NOT.MAR345) THEN
IF (NREC.EQ.3450) THEN
HRAST = 0.10
ELSE IF (NREC.EQ.3000) THEN
HRAST = 0.10
ELSE IF (NREC.EQ.2400) THEN
HRAST = 0.10
ELSE IF (NREC.EQ.2300) THEN
HRAST = 0.15
ELSE IF (NREC.EQ.2000) THEN
HRAST = 0.15
ELSE IF (NREC.EQ.1800) THEN
HRAST = 0.10
ELSE IF (NREC.EQ.1600) THEN
HRAST = 0.15
ELSE IF (NREC.EQ.1200) THEN
HRAST = 0.15
END IF
END IF
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6010) NREC,IYLEN,ILRECL,
+ NNREC,NOVFL,NRECOVFL,BYTSWAP,HDIST,HWAVE,HPHIS,HPHIE,
+ HRAST
IF (ONLINE) WRITE(ITOUT,FMT=6010) NREC,IYLEN,ILRECL,
+ NNREC,NOVFL,NRECOVFL,BYTSWAP,HDIST,HWAVE,HPHIS,HPHIE,
+ HRAST
6010 FORMAT(1X,'From header record in image',/,1X,
+ 'NREC=',I5,' IYLEN=',I5,' LREC=',I5,' NREC=',I5,
+ ' NOVFL=',I5,' NRECOVFL=',I5,/,1X,'Byte-swapping ',L1,
+ /,1X,'Distance:',F8.2,' Wavelength:',F8.5,' Phi',
+ ' start',F9.3,' Phi end:',F9.3,' Pixel size',F7.3,'mm')
NROWS = NITEM/5 + 1
I1 = 1
I2 = I1 + 4
DO 2 I = 1,NROWS
WRITE(IOUT,FMT=6012) I1,I2,(IHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6012)
+ I1,I2,(IHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
2 CONTINUE
I1 = 1
I2 = I1 + 4
DO 4 I = 1,NROWS
WRITE(IOUT,FMT=6014) I1,I2,(RHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6014)
+ I1,I2,(RHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
4 CONTINUE
CAL NROWS = 20
I1 = 1
I2 = I1 + 4
DO 6 I = 1,NROWS
WRITE(IOUT,FMT=6016) I1,I2,(CHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6016)
+ I1,I2,(CHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
6 CONTINUE
END IF
C
C ********************************
ELSE IF (MACHINE.EQ.'RAXI') THEN
C ********************************
C
C---- When we first come to read the header, we do not know the record length
C (NBYTE will be zero) so only read the first 1600 bytes (400 I*4 words) but
C once the record length is known, read whole record
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6018) NBYTE,ISWAP
IF (ONLINE) WRITE(ITOUT,FMT=6018) NBYTE,ISWAP
6018 FORMAT(/,1X,'In GETHDR, NBYTE=',I6,' ISWAP=',I3)
END IF
IF (NBYTE.EQ.0) THEN
NNBYTE = 1600
ELSE
NNBYTE = NBYTE
END IF
IERR = 0
CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
C---- Work out byte order by checking value of NREC
C NITEM is number of words we want to use from header
NITEM = 400
BYTSWAP = .FALSE.
NREC = IHEAD(193)
IF ((NREC.NE.950).AND.(NREC.NE.1900).AND.(NREC.NE.1500)
+ .AND.(NREC.NE.3000).AND.(NREC.NE.6000)
$ .AND.(NREC.NE.4000).AND.(NREC.NE.8000)) THEN
NXPIXO = NREC
CALL SWAPHDR(IHEAD(1),NITEM)
BYTSWAP = .TRUE.
NREC = IHEAD(193)
IF ((NREC.NE.950).AND.(NREC.NE.1900).AND.(NREC.NE.1500)
+ .AND.(NREC.NE.3000).AND.(NREC.NE.6000)
$ .AND.(NREC.NE.4000).AND.(NREC.NE.8000)) THEN
WRITE(IOUT,FMT=6002) NXPIXO,NREC
IF (ONLINE) WRITE(ITOUT,FMT=6002) NXPIXO,NREC
6002 FORMAT(//1X,' **** FATAL ERROR ****',/,1X,'The number',
+ ' of pixels in the X direction must be 950, 1500,',
+ '1900, 3000, 4000, 6000 or 8000',
+ /,1X,'The number from the first word of the',
+ ' header record is',I16,/,1X,'with original byte ',
+ 'order or',I16,/,1X,'with swapped byte order')
ISTAT = -2
RETURN
END IF
WRITE(IOUT,FMT=6001)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
END IF
IYLEN = IHEAD(194)
C
C---- Distance, wavelength and phi values are only present in RaxisIV image
C headers (as far as I can tell !!)
C
HDIST = 0.0
HWAVE = 0.0
HPHIS = 0.0
HPHIE = 0.0
C
C---- Use header information to work out if there are "extra" bytes
C at the end of each record. (Present on all but latest R-axis II images)
C
IF ((MODEL.NE.'RAXISIV').AND.(MODEL.NE.'RAXISV'))
$ NEXTRA = IHEAD(197) - 2*IYLEN
C
IF ((MODEL.EQ.'RAXISIV').or.(MODEL.EQ.'RAXISV')) THEN
IF (.NOT.QISNAN(RHEAD(74))) HWAVE = RHEAD(74)
IF (.NOT.QISNAN(RHEAD(87))) HDIST = RHEAD(87)
IF (.NOT.QISNAN(RHEAD(132))) HPHIS = RHEAD(132)
IF (.NOT.QISNAN(RHEAD(133))) HPHIE = RHEAD(133)
END IF
If (Debug(45)) Then
Write(Iout,Fmt=6008) NREC,IYLEN,Nextra,
+ Bytswap,Hdist,Hwave,Hphis,Hphie
If (Online) Write(Itout,Fmt=6008) NREC,IYLEN,Nextra,Bytswap,
+ Hdist,Hwave,Hphis,Hphie
6008 Format(1x,'From Header Record In Image',/,1x,
+ 'NREC=',I5,' IYLEN=',I5,' Nextra=',I5,
+ /,1x,'Byte-Swapping ',L1,
+ /,1x,'Distance:',F8.2,' Wavelength:',F8.5,' Phi',
+ ' Start',F9.3,' Phi End:',F9.3)
NROWS = NITEM/5 + 1
I1 = 1
I2 = I1 + 4
DO 7 I = 1,NROWS
WRITE(IOUT,FMT=6012) I1,I2,(IHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6012)
+ I1,I2,(IHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
7 CONTINUE
6012 FORMAT(//1X,'Header record as integers',/,
+ (1X,'Items ',I3,' to ',I3,5X,5I12))
C
I1 = 1
I2 = I1 + 4
DO 8 I = 1,NROWS
WRITE(IOUT,FMT=6014) I1,I2,(RHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6014)
+ I1,I2,(RHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
8 CONTINUE
6014 FORMAT(//1X,'Header record as reals',/,
+ (1X,'Items ',I3,' to ',I3,5X,5E12.3))
C
CAL NROWS = 20
I1 = 1
I2 = I1 + 4
DO 9 I = 1,NROWS
WRITE(IOUT,FMT=6016) I1,I2,(CHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6016)
+ I1,I2,(CHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
9 CONTINUE
6016 FORMAT(//1X,'Header record as characters',/,
+ (1X,'Items ',I3,' to ',I3,5X,20A))
END IF
C ********************************
ELSE IF (MACHINE.EQ.'ADSC') THEN
C ********************************
C
C---- There are always at least 512 bytes in the header (there may be more)
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6018) NBYTE,ISWAP
IF (ONLINE) WRITE(ITOUT,FMT=6018) NBYTE,ISWAP
END IF
IERR = 0
NNBYTE = 512
FIRSTTIME = .TRUE.
10 CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
IF (DEBUG(45)) THEN
NITEM = NNBYTE/4
WRITE(IOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
6030 FORMAT(1X,20A1)
END IF
C
C---- Decode the header information
C
NCH = 0
NCH = NCH + 1
IF (CHEAD(NCH).EQ.'{') THEN
C
C---- Start of header, skip to start of first line
C
NCH = NCH + 2
C
C---- Search for end of this line
C
NSTART = NCH
14 IF (CHEAD(NCH).EQ.'}') GOTO 18
C
IF (CHEAD(NCH).EQ.';') GOTO 16
NCH = NCH + 1
IF (NCH.GT.NNBYTE) THEN
WRITE(IOUT,FMT=6032)
IF (ONLINE) WRITE(ITOUT,FMT=6032)
6032 FORMAT(//,1X,'**** ERROR READING HEADER ****')
ISTAT = -2
RETURN
END IF
GOTO 14
C
16 NEND = NCH - 1
NCHAR = NEND-NSTART+1
LINE = ' '
IF (NCHAR.LT.133)
+ WRITE(LINE,FMT=6034) (CHEAD(I),I=NSTART,NEND)
6034 FORMAT(132A1)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6036) LINE(1:LENSTR(LINE))
IF (ONLINE) WRITE(ITOUT,FMT=6036) LINE(1:LENSTR(LINE))
6036 FORMAT(1X,'LINE IS: ',A)
END IF
C
C---- Decode keyword
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
KEY = LINE(IBEG(1) :IEND(1))
CALL CCPUPC(KEY)
IF (KEY.EQ.'HEADER_BYTES') THEN
NHBYTES = NINT(VALUE(2))
NNBYTE = NHBYTES
IF (FIRSTTIME) THEN
NHBYTES = NHBYTES - 512
IF (NHBYTES.GT.0) THEN
CALL GETBLK(IHEAD(129),NHBYTES,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
END IF
FIRSTTIME = .FALSE.
END IF
ELSE IF (KEY.EQ.'BYTE_ORDER') THEN
BORDER = LINE(IBEG(2):IEND(2))
CALL CCPUPC(BORDER)
BYTSWAP = ((LITEND().AND.(BORDER.EQ.'BIG')).OR.
+ (.NOT.LITEND().AND.(BORDER.NE.'BIG')))
ELSE IF (KEY.EQ.'SIZE1') THEN
IYLEN = NINT(VALUE(2))
ELSE IF (KEY.EQ.'SIZE2') THEN
NREC = NINT(VALUE(2))
ELSE IF (KEY.EQ.'PIXEL_SIZE') THEN
HRAST = VALUE(2)
ELSE IF (KEY.EQ.'DISTANCE') THEN
HDIST = VALUE(2)
ELSE IF (KEY.EQ.'WAVELENGTH') THEN
HWAVE = VALUE(2)
ELSE IF (KEY.EQ.'OSC_RANGE') THEN
OSCRNG = VALUE(2)
C---- Confusion exists about whether the phi start should be taken
C from the PHI keyword or the OSC_START keyword. For the SSRL ADSC
C detector OSC_START is always zero, so use PHI.
C ELSE IF (KEY.EQ.'OSC_START') THEN
ELSE IF (KEY.EQ.'PHI') THEN
HPHIS = VALUE(2)
ELSE IF (KEY.EQ.'TWO_THETA') THEN
HTWOTHETA = VALUE(2)
C
C---- add beam position read from image header
C
ELSE IF (KEY.EQ.'BEAM_CENTER_X')THEN
HBEAMX = VALUE(2)
ELSE IF (KEY.EQ.'BEAM_CENTER_Y')THEN
HBEAMY = VALUE(2)
END IF
NCH = NCH + 2
NSTART = NCH
GOTO 14
END IF
18 HPHIE = HPHIS + OSCRNG
IF((HBEAMX.GT.0.0).AND.(HBEAMY.GT.0.0).AND.(IBEAM.EQ.0))IBEAM=3
C
C---- Put in new code here to decode header information for other
C types of scanner
C
C ********************************
ELSE IF (MACHINE.EQ.'LIPS') THEN
C ********************************
IERR = 0
C
C---- Header size is variable, so read in 2000 bytes and find the end
C of the header, denoted by } and newline.
C
NNBYTE = 2000
FIRSTTIME = .TRUE.
20 CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
IF (DEBUG(45)) THEN
NITEM = NNBYTE
WRITE(IOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
END IF
C
C---- Find the terminator, also count number of newline characters
C This assumes that the second character is a newline.
C
NULINE = CHEAD(2)
NHLINES = 0
NSTART = 1
DO 22 I = 1,NNBYTE
IF (CHEAD(I).EQ.NULINE) THEN
NHLINES = NHLINES + 1
IF (NHLINES.GT.NHLMAX) THEN
WRITE(IOUT,FMT=6052) NHLINES,NHLMAX
IF (ONLINE) WRITE(ITOUT,FMT=6052) NHLINES,NHLMAX
6052 FORMAT(/,1X,'***** FATAL ERROR *****',/,1X,'There are',I5,
+ ' lines in the header, but program is dimensioned',/,1X,
+ 'for a maximum oF',I5,'. Change parameter NHLMAX in ',
+ 'subroutine gethdr.')
ISTAT = -2
RETURN
END IF
NCHAR = I - NSTART + 1
DO 23 J = 1,NCHAR
HLINES(NHLINES)(J:J) = CHEAD(NSTART+J-1)
23 CONTINUE
NSTART = I + 1
END IF
IF (CHEAD(I).EQ.'}') THEN
NTERM = I
GOTO 24
END IF
22 CONTINUE
C
C---- ERROR, terminator not found
C
WRITE(IOUT,FMT=6050) NNBYTE,MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6050) NNBYTE,MACHINE
6050 FORMAT(/,1X,'***** FATAL ERROR *****',/,1X,'Terminator ',
+ ' "}" not found in first',I6,' bytes of header',/,1X,
+ 'for scanner type: ',A)
ISTAT = -2
RETURN
C
C---- Terminator found, transfer header info to separate lines into
C array HLINES. Assumes there are not more than NHLMAX lines in header.
C
24 NHBYTE = NTERM + 1
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6056) NHLINES,(HLINES(I),I=1,NHLINES)
IF (ONLINE) WRITE(ITOUT,FMT=6056) NHLINES,
+ (HLINES(I),I=1,NHLINES)
6056 FORMAT(1X,'There are',I4,' lines in the header as follows',
+ /,(1X,A))
END IF
C
C---- Now parse the lines to get image size
C
DO 26 I = 1,NHLINES
C ******************************************
CALL MPARSE(HLINES(I),IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
KEY = HLINES(I)(IBEG(1) :IEND(1))
CALL CCPUPC(KEY)
IF (KEY.EQ.'DIM_1') THEN
IYLEN = NINT(VALUE(2))
ELSE IF (KEY.EQ.'DIM_2') THEN
NREC = NINT(VALUE(2))
ELSE IF (KEY.EQ.'PIXSIZE') THEN
HRAST = 0.001*NINT(VALUE(2))
ELSE IF (KEY.EQ.'BYTEORDER') THEN
BORDER2 = HLINES(I)(IBEG(2):IEND(2))
CALL CCPUPC(BORDER2)
BYTSWAP = .NOT.((LITEND().AND.(BORDER.EQ.'HIGHBYTEFIRST'))
+ .OR.(.NOT.LITEND().AND.(BORDER.NE.'HIGHBYTEFIRST')))
END IF
26 CONTINUE
C
C---- Now position file in correct place.
C
CALL QBACK(INOD,NNBYTE)
CALL GETBLK(IHEAD(1),NHBYTE,1,ISWAP,IERR)
C
C---- Mar CCD detector (type MARCCD)
C
C ********************************
ELSE IF (MACHINE.EQ.'MARC') THEN
C ********************************
C
C---- When we first come to read the header, we do not know the record length
C (NBYTE will be zero) so only read the first 2048 bytes (512 I*4 words) but
C once the record length is known, read whole record
C
IF (NBYTE.EQ.0) THEN
NNBYTE = 2048
ELSE
NNBYTE = NBYTE
END IF
IERR = 0
CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
C---- Work out byte order
C NITEM is number of words we want to use from header
C
NITEM = 512
BYTSWAP = .FALSE.
C
IORD = IHEAD(264)
IF (IORD.NE.1234) THEN
IORDO = IORD
CALL SWAPHDR(IHEAD(1),NITEM)
BYTSWAP = .TRUE.
IORD = IHEAD(264)
IF (IORD.NE.1234) THEN
WRITE(IOUT,FMT=6040) IORDO,IORD
IF (ONLINE) WRITE(ITOUT,FMT=6040) IORDO,IORD
6040 FORMAT(//1X,' **** FATAL ERROR ****',/,1X,'The byte order',
+ ' flag must be 1234. With the original byte order',
+ ' it is',I16,/,1X,'and with swapped byte order',
+ ' it is',I16,/,1X,'Is this really a MAR CCD image ?')
ISTAT = -2
RETURN
END IF
WRITE(IOUT,FMT=6001)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
END IF
NREC = IHEAD(277)
IYLEN = IHEAD(278)
ILRECL = IYLEN*IHEAD(279)
HIOVER = IHEAD(283)
HRAST = 0.000001*IHEAD(450)
HRASTY = 0.000001*IHEAD(451)
HNULLPIX = NINT(0.001*IHEAD(452))
HWAVE = 0.00001*IHEAD(484)
HDIST = 0.001*IHEAD(431)
IAXIS = IHEAD(440)
IF ((IAXIS.LT.1).OR.(IAXIS.GT.6)) THEN
IAXIS = 4
WRITE(IOUT,FMT=6046)
IF (ONLINE) WRITE(ITOUT,FMT=6046)
6046 FORMAT(1X,'***** WARNING *****',/,1X,
+ 'Unrecognised rotation axis in header, phi values',
+ ' from header',/,1X,'may be incorrect.')
END IF
HTWOTHETA = 0.001*IHEAD(424)
HPHIS = 0.001*IHEAD(424+IAXIS)
HPHIE = 0.001*(IHEAD(424+IAXIS) + IHEAD(441))
IF((HPHIS.GT.HPHIE).AND.(HPHIS-360.0.LT.HPHIE))
$ THEN
HPHIE = HPHIE + 360.0
ENDIF
WORK(1) = 0.001*IHEAD(424)
WORK(2) = 0.001*IHEAD(425)
WORK(3) = 0.001*IHEAD(426)
WORK(4) = 0.001*IHEAD(427)
WORK(5) = 0.001*IHEAD(428)
WORK(6) = 0.001*IHEAD(429)
WORK(7) = 0.001*IHEAD(430)
WORK(8) = 0.001*IHEAD(431)
WORK(9) = 0.001*IHEAD(432)
WORK(10) = 0.001*IHEAD(433)
WORK(11) = 0.001*IHEAD(434)
WORK(12) = 0.001*IHEAD(435)
WORK(13) = 0.001*IHEAD(436)
WORK(14) = 0.001*IHEAD(437)
WORK(15) = 0.001*IHEAD(438)
WORK(16) = 0.001*IHEAD(439)
WORK(17) = 0.001*IHEAD(440)
WORK(18) = 0.001*IHEAD(441)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6042) NREC,IYLEN,ILRECL,
+ BYTSWAP,HDIST,HWAVE,HPHIS,HPHIE,
+ HRAST,HRASTY,HTWOTHETA,HNULLPIX,(WORK(I),I=1,18)
IF (ONLINE) WRITE(ITOUT,FMT=6042) NREC,IYLEN,ILRECL,
+ BYTSWAP,HDIST,HWAVE,HPHIS,HPHIE,
+ HRAST,HRASTY,HTWOTHETA,HNULLPIX,(WORK(I),I=1,18)
6042 FORMAT(1X,'From header record in image',/,1X,
+ 'NREC=',I5,' IYLEN=',I5,' LREC=',I5,
+ ' Byte-swapping ',L1,
+ /,1X,'Distance:',F8.2,' Wavelength:',F8.5,' Phi',
+ ' start',F9.3,' Phi end:',F9.3,' Pixel size in X',
+ F7.3,'mm',' Pixel size in Y',F7.3,'mm.',/,1X,
+ 'Two theta',F8.3,' Null pixel value',I5,
+ /,(1X,8F10.2))
END IF
C ********************************
C---- Ed Westbrooks 3x3 detector SBC-1
C ********************************
C
C ********************************
ELSE IF (MACHINE.EQ.'SBC1') THEN
C ********************************
C
C---- There are always at least 512 bytes in the header (and usually many more)
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6018) NBYTE,ISWAP
IF (ONLINE) WRITE(ITOUT,FMT=6018) NBYTE,ISWAP
END IF
IERR = 0
NNBYTE = 512
BLPHSTART = ' '
BLPHEND = ' '
BLPHINC = ' '
DETNAME = ' '
FIRSTTIME = .TRUE.
30 CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
IF (DEBUG(45)) THEN
NITEM = NNBYTE/4
WRITE(IOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
END IF
C
C---- Decode the header information
C
NCH = 0
NCH = NCH + 1
IF (CHEAD(NCH).EQ.'{') THEN
C
C---- Start of header, skip to start of first line
C
NCH = NCH + 2
C
C---- Search for end of this line
C
NSTART = NCH
32 IF (CHEAD(NCH).EQ.'}') GOTO 36
C
IF (CHEAD(NCH).EQ.';') GOTO 34
NCH = NCH + 1
IF (NCH.GT.NNBYTE) THEN
WRITE(IOUT,FMT=6032)
IF (ONLINE) WRITE(ITOUT,FMT=6032)
ISTAT = -2
RETURN
END IF
GOTO 32
C
34 NEND = NCH - 1
NCHAR = NEND-NSTART+1
LINE = ' '
IF (NCHAR.LT.133)
+ WRITE(LINE,FMT=6034) (CHEAD(I),I=NSTART,NEND)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6036) LINE(1:LENSTR(LINE))
IF (ONLINE) WRITE(ITOUT,FMT=6036) LINE(1:LENSTR(LINE))
END IF
C
C---- Decode keyword
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
KEY = LINE(IBEG(1) :IEND(1))
CALL CCPUPC(KEY)
IF (KEY.EQ.'HEADER_BYTES') THEN
NHBYTES = NINT(VALUE(2))
NNBYTE = NHBYTES
IF (FIRSTTIME) THEN
NHBYTES = NHBYTES - 512
C
C---- Check if header is too long to store
C
IF (NNBYTE.GT.MAXHEAD*4) THEN
WRITE(IOUT,FMT=6060) NNBYTE,MAXHEAD*4,NNBYTE/4+1
IF (ONLINE) WRITE(ITOUT,FMT=6060) NNBYTE,MAXHEAD,
+ NNBYTE/4+1
6060 FORMAT(//,1X,'***** ERROR *****',/,1X,'The image ',
+ 'header has ',I7,' bytes but the maximum allowed',
+ ' is',I7,/,1X,'Change the parameter MAXHEAD to at',
+ ' least',I7,' with a global edit and recompile.')
ISTAT = -2
RETURN
END IF
C
IF (NHBYTES.GT.0) THEN
CALL GETBLK(IHEAD(129),NHBYTES,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
END IF
FIRSTTIME = .FALSE.
END IF
ELSE IF (KEY.EQ.'BYTE_ORDER') THEN
BORDER = LINE(IBEG(2):IEND(2))
CALL CCPUPC(BORDER)
BYTSWAP = ((LITEND().AND.(BORDER.EQ.'BIG')).OR.
+ (.NOT.LITEND().AND.(BORDER.NE.'BIG')))
ELSE IF (KEY.EQ.'SIZE1') THEN
IYLEN = NINT(VALUE(2))
ELSE IF (KEY.EQ.'SIZE2') THEN
NREC = NINT(VALUE(2))
ELSE IF (KEY.EQ.'SCAN_WAVELENGTH') THEN
HWAVE = VALUE(2)
ELSE IF (KEY.EQ.'SOURCE_POLARZ') THEN
HTOR = VALUE(2)
ELSE IF (KEY.EQ.'BEAMLINE_NAME') THEN
BLNAME = LINE(IBEG(2):IEND(2))
NCH2 = LENSTR(BLNAME)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6064) BLNAME
IF (ONLINE) WRITE(ITOUT,FMT=6064) BLNAME
6064 FORMAT(1X,'Beamline name: ',A)
END IF
IF (NCH2.GT.10) THEN
WRITE(IOUT,FMT=6062) BLNAME
IF (ONLINE) WRITE(ITOUT,FMT=6062) BLNAME
6062 FORMAT(1X,'***** ERROR *****',/,1X,'The beamline',
+ ' name (',A,') in the image header is more than 10',
+ ' characters,',/,1X,'which means that the keywords',
+ ' will not be identified correctly.',/,1X,'Make ',
+ 'changes to subroutine GETHDR.')
ISTAT = -2
RETURN
END IF
BLPHSTART = BLNAME(1:NCH2)//'ROTATION_START'
BLPHEND = BLNAME(1:NCH2)//'ROTATION_END'
BLPHINC = BLNAME(1:NCH2)//'SCAN_INCREMENT'
ELSE IF (KEY.EQ.'DETECTOR_NAMES') THEN
DETNAME = LINE(IBEG(2):IEND(2))
NCH2 = LENSTR(DETNAME)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6066) DETNAME
IF (ONLINE) WRITE(ITOUT,FMT=6066) DETNAME
6066 FORMAT(1X,'Detector name: ',A)
END IF
DETDIST = DETNAME(1:NCH2)//'GONIO_VALUES'
ELSE IF (KEY.EQ.BLPHSTART) THEN
HPHIS = VALUE(2)
ELSE IF (KEY.EQ.BLPHEND) THEN
HPHIE = VALUE(2)
ELSE IF (KEY.EQ.DETDIST) THEN
HDIST = VALUE(7)
HTWOTHETA = VALUE(3)
END IF
NCH = NCH + 2
NSTART = NCH
GOTO 32
END IF
36 IF (NREC.EQ.3072) THEN
HRAST = 0.06836
ELSE IF (NREC.EQ.1536) THEN
HRAST = 0.13672
END IF
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6070) NREC,IYLEN,HRAST,HTOR,
+ BYTSWAP,HDIST,HWAVE,HPHIS,HPHIE,HTWOTHETA
IF (ONLINE) WRITE(ITOUT,FMT=6070) NREC,IYLEN,HRAST,HTOR,
+ BYTSWAP,HDIST,HWAVE,HPHIS,HPHIE,HTWOTHETA
6070 FORMAT(1X,'From header record in image',/,1X,
+ 'NREC=',I5,' IYLEN=',I5,' Pixel size',F8.5,' mm',
+ ' Beam polarisation',F6.4,/,1X,'Byte-swapping ',L1,
+ /,1X,'Distance:',F8.2,' Wavelength:',F8.5,' Phi',
+ ' start',F9.3,' Phi end:',F9.3,' Twotheta',F7.3)
END IF
C ********************************
ELSE IF (MACHINE.EQ.'JUPI') THEN
C ********************************
C
C---- There are always at least 512 bytes in the header (there may be more)
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6018) NBYTE,ISWAP
IF (ONLINE) WRITE(ITOUT,FMT=6018) NBYTE,ISWAP
END IF
IERR = 0
NNBYTE = 512
FIRSTTIME = .TRUE.
C
C---- following added for beam centre from header stuff - Jupiter and ADSC Q4
C
SIMPLE = .FALSE.
BEAMSET = .FALSE.
HBEAMX = 0.0
HBEAMY = 0.0
CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
IF (DEBUG(45)) THEN
NITEM = NNBYTE/4
WRITE(IOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6030) (CHEAD(I),I=1,NITEM)
chrp12032001 6030 FORMAT(1X,20A1)
END IF
C
C---- Decode the header information
C
NCH = 0
NCH = NCH + 1
IF (CHEAD(NCH).EQ.'{') THEN
C
C---- Start of header, skip to start of first line
C
NCH = NCH + 2
C
C---- Search for end of this line
C
NSTART = NCH
1014 IF (CHEAD(NCH).EQ.'}') GOTO 1018
C
IF (CHEAD(NCH).EQ.';') GOTO 1016
NCH = NCH + 1
IF (NCH.GT.NNBYTE) THEN
WRITE(IOUT,FMT=6032)
IF (ONLINE) WRITE(ITOUT,FMT=6032)
chrp12032001 6032 FORMAT(//,1X,'**** ERROR READING HEADER ****')
ISTAT = -2
RETURN
END IF
GOTO 1014
C
1016 NEND = NCH - 1
NCHAR = NEND-NSTART+1
LINE = ' '
IF (NCHAR.LT.133)
+ WRITE(LINE,FMT=6034) (CHEAD(I),I=NSTART,NEND)
chrp12032001 6034 FORMAT(132A1)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6036) LINE(1:LENSTR(LINE))
IF (ONLINE) WRITE(ITOUT,FMT=6036) LINE(1:LENSTR(LINE))
chrp12032001 6036 FORMAT(1X,'LINE IS: ',A)
END IF
C
C---- Decode keyword
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
KEY = LINE(IBEG(1) :IEND(1))
CALL CCPUPC(KEY)
IF (KEY.EQ.'HEADER_BYTES') THEN
NHBYTES = NINT(VALUE(2))
NNBYTE = NHBYTES
IF (FIRSTTIME) THEN
NHBYTES = NHBYTES - 512
IF (NHBYTES.GT.0) THEN
CALL GETBLK(IHEAD(129),NHBYTES,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
END IF
FIRSTTIME = .FALSE.
END IF
ELSE IF (KEY.EQ.'BYTE_ORDER') THEN
BORDER = LINE(IBEG(2):IEND(2))
CALL CCPUPC(BORDER)
BYTSWAP = ((LITEND().AND.(BORDER.EQ.'BIG')).OR.
+ (.NOT.LITEND().AND.(BORDER.NE.'BIG')))
ELSE IF (KEY.EQ.'SIZE1') THEN
IYLEN = NINT(VALUE(2))
ELSE IF (KEY.EQ.'SIZE2') THEN
NREC = NINT(VALUE(2))
c
c---- pixel size isn't stored as such in the example I have, but it can
c be calculated from CCD_DETECTOR_SIZE/SIZE1
c
c ELSE IF (KEY.EQ.'PIXEL_SIZE') THEN
c HRAST = VALUE(2)
ELSE IF (KEY.EQ.'CCD_DETECTOR_SIZE') THEN
HSIZED = VALUE(2)
ELSE IF (KEY.EQ.'SCAN_DET_RELZERO') THEN
HDIST = VALUE(4)
ELSE IF (KEY.EQ.'SOURCE_WAVELENGTH') THEN
HWAVE = VALUE(3)
ELSE IF (KEY.EQ.'ROTATION') THEN
HPHIS = VALUE(2)
HPHIE = VALUE(3)
OSCRNG = VALUE(4)
c
c---- twotheta swing is stored in a general way; first CCD_GONIO_NAMES
C has to be parsed to find which item is '2Theta', then CCD_GONIO_UNITS
c to find the units ('deg'?) in that item's slot, then CCD_GONIO_VALUES
c to pick up the value, then CCD_GONIO_VECTORS to find out which axis
c two-theta is swung about.
c
c ELSE IF (KEY.EQ.'TWO_THETA') THEN
c HTWOTHETA = VALUE(2)
ELSE IF (KEY.EQ.'CCD_SPATIAL_DISTORTION_TYPE') THEN
IF(LINE(IBEG(2):IEND(2)).EQ.'Simple_spatial')
$ SIMPLE = .TRUE.
ELSE IF (KEY.EQ.'CCD_SPATIAL_DISTORTION_INFO') THEN
BEAMXD = VALUE(2)*VALUE(4)
BEAMYD = VALUE(3)*VALUE(5)
BEAMSET = .TRUE.
END IF
NCH = NCH + 2
NSTART = NCH
GOTO 1014
END IF
1018 HPHIE = HPHIS + OSCRNG
IF((HSIZED.GT.0.0).AND.(IYLEN.GT.0))HRAST=HSIZED/FLOAT(IYLEN)
IF(SIMPLE.and.BEAMSET)THEN
c Calculate beam centre...
HBEAMX =
$ ABS(BEAMXD * COS(OMEGAF) + BEAMYD * SIN(OMEGAF))
HBEAMY =
$ ABS(BEAMXD * SIN(OMEGAF) + BEAMYD * COS(OMEGAF))
IF(IBEAM.EQ.0)IBEAM = 3
ENDIF
C ********************************
ELSE IF (MACHINE.EQ.'BRUK') THEN
C ********************************
C
C---- Bruker images have a multiple of 512 bytes in the image header, but
C each record is 80 bytes
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6018) NBYTE,ISWAP
IF (ONLINE) WRITE(ITOUT,FMT=6018) NBYTE,ISWAP
END IF
IERR = 0
NNBYTE = 80
SUMBYTES = 0
2010 CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
SUMBYTES = SUMBYTES + 80
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6030) (CHEAD(I),I=1,NNBYTE)
IF (ONLINE) WRITE(ITOUT,FMT=6030) (CHEAD(I),I=1,NNBYTE)
END IF
C
C---- Decode the header information
C
NCH = 0
NCH = NCH + 1
C
C---- Search for end of this line
C
NSTART = NCH
C
C---- end of header ----
C
2014 IF (CHEAD(NCH).EQ.'ENDING2') GOTO 2018
C
C---- end of line
C
IF (NCH.GE.nnbyte) GOTO 2016
NCH = NCH + 1
IF (NCH.GT.NNBYTE) THEN
WRITE(IOUT,FMT=6032)
IF (ONLINE) WRITE(ITOUT,FMT=6032)
ISTAT = -2
RETURN
END IF
GOTO 2014
C
2016 NEND = NCH - 1
NCHAR = NEND-NSTART+1
LINE = ' '
IF (NCHAR.LT.133)
+ WRITE(LINE,FMT=6034) (CHEAD(I),I=NSTART,NEND)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6036) LINE(1:LENSTR(LINE))
IF (ONLINE) WRITE(ITOUT,FMT=6036) LINE(1:LENSTR(LINE))
END IF
C
C---- Decode keyword
C
C ******************************************
CALL MPARSE(LINE(9:80),IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
KEY = LINE(1:8)
CALL CCPUPC(KEY)
C
C---- start checking against known contents of header
C
IF (KEY.EQ.'NROWS :') THEN
IYLEN = NINT(VALUE(1))
ELSE IF (KEY.EQ.'NCOLS :') THEN
NREC = NINT(VALUE(1))
ELSE IF (KEY.EQ.'DISTANC:') THEN
C
C--- distance in CM on Bruker images
C
HDIST = VALUE(1)*10.0
ELSE IF (KEY.EQ.'WAVELEN:') THEN
HWAVE = VALUE(1)
ELSE IF (KEY.EQ.'START :') THEN
HPHIS = VALUE(1)
ELSE IF (KEY.EQ.'RANGE :') THEN
OSCRNG = VALUE(1)
ELSE IF (KEY.EQ.'ANGLES :') THEN
C
C---- Bruker header has angles (1) twotheta, (2) omega, (3) phi, (4) chi
HTWOTHETA = VALUE(1)
C
C---- add beam position read from image header; Bruker images have this
C in Pixels, so we need to convert
C
ELSE IF (KEY.EQ.'CENTER :')THEN
HBEAMX = VALUE(1) * RAST
HBEAMY = VALUE(2) * RAST
ELSE IF (KEY.EQ.'ENDING2:')THEN
GOTO 2018
END IF
NCH = NCH + 2
NSTART = NCH
GOTO 2010
c END IF
2018 HPHIE = HPHIS + OSCRNG
IF((HBEAMX.GT.0.0).AND.(HBEAMY.GT.0.0).AND.(IBEAM.EQ.0))IBEAM=3
C
C---- now check for the end of the header block
C
CHECKSUM = SUMBYTES-((SUMBYTES/512)*512)
CALL GETBLK(IHEAD(1),CHECKSUM,1,ISWAP,IERR)
ELSE
C
C---- Header records not to be used, just skip them
C
IF (NHBYTE.EQ.0) NHBYTE = NBYTE
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6020) NHBYTE,NHEAD
IF (ONLINE) WRITE(ITOUT,FMT=6020) NHBYTE,NHEAD
6020 FORMAT(1X,'Skipping',I6,' bytes in',I3,' header records')
END IF
IERR = 0
DO 90 K = 1,NHEAD
CALL GETBLK(IHEAD(1),NHBYTE,1,ISWAP,IERR)
IF (DEBUG(45)) THEN
NITEM = NHBYTE/4
NROWS = NITEM/5 + 1
I1 = 1
I2 = I1 + 4
DO 92 I = 1,NROWS
WRITE(IOUT,FMT=6012) I1,I2,(IHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6012)
+ I1,I2,(IHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
92 CONTINUE
I1 = 1
I2 = I1 + 4
DO 94 I = 1,NROWS
WRITE(IOUT,FMT=6014) I1,I2,(RHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6014)
+ I1,I2,(RHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
94 CONTINUE
CAL NROWS = 20
I1 = 1
I2 = I1 + 4
DO 96 I = 1,NROWS
WRITE(IOUT,FMT=6016) I1,I2,(CHEAD(J),J=I1,I2)
IF (ONLINE) WRITE(ITOUT,FMT=6016)
+ I1,I2,(CHEAD(J),J=I1,I2)
I1 = I1 + 5
I2 = MIN(NITEM, I1+4)
96 CONTINUE
END IF
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) MACHINE
IF (ONLINE) WRITE(ITOUT,FMT=6004) MACHINE
ISTAT = -1
RETURN
END IF
C
90 CONTINUE
END IF
RETURN
END
C== GETHKL ==
C
C
C
SUBROUTINE GETHKL(JREC,IH)
C ==========================
C
C
C
C---- Find indices m,x and y for jrec'th reflection
C in generate file
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER JREC
C ..
C .. Array Arguments ..
INTEGER IH(7)
C ..
C .. Local Scalars ..
INTEGER I,IR,IM
C ..
C .. Local Arrays ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C---- Extract indices from /GENDATA/
C
IH(1) = IHG(JREC)
IH(2) = IKG(JREC)
IH(3) = ILG(JREC)
C
IR = IRG(JREC)
IM = IMG(JREC)
IH(4) = IM
IH(5) = IR
IH(6) = NINT(XG(JREC))
IH(7) = NINT(YG(JREC))
C
END
C== GETINDX ==
C
SUBROUTINE GETINDX(NDISP,IXP,IYP,IHKL,IRECG)
C
C---- Finds indices of reflection at display coordinates IXP,IYP
C
C Returns IHKL with h,k,l in 1-3, IM in 4, IR in 5.
C IRECG is the record number, but -1 if no reflection found
C within 4 pixels
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER NDISP,IXP,IYP,IRECG
C ..
C .. Array Arguments ..
INTEGER IHKL(5)
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER I,J,MP,KSYM,IAX,IAY,INDEX,IR,IRMIN
C ..
C .. Local Arrays ..
INTEGER IH(7),HKLAU(3),KHKL(3)
C ..
C .. External Subroutines ..
EXTERNAL GETHKL,ASUGET
C ..
C .. Extrinsic Functions ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C---- Find reflection nearest the given image pixel coords
C
INDEX = 0
IRMIN = 17
DO 10 I = 1,NDISP
IAX = ABS(IXP-IX(I))
IAY = ABS(IYP-IY(I))
IF (IAX.GT.4) GOTO 10
IF (IAY.GT.4) GOTO 10
IR = IAX*IAX + IAY*IAY
IF (IR.LT.IRMIN) THEN
INDEX = I
IRMIN = IR
END IF
10 CONTINUE
IF (INDEX.NE.0) THEN
C
C---- Reflection found
C
IRECG = IREC(INDEX)
CALL GETHKL(IRECG,IH)
C
C---- If finding reflection after integration of image indices of all
C but rejected spots will have been reduced to asymmetric unit
C so need to recover original indices
C
MP = MISYMG(IRECG)
IF (MP.NE.0) THEN
HKLAU(1) = IH(1)
HKLAU(2) = IH(2)
HKLAU(3) = IH(3)
MP = MP/256
KSYM = MISYMG(IRECG) - MP*256
CALL ASUGET(HKLAU,KHKL,KSYM)
IH(1) = KHKL(1)
IH(2) = KHKL(2)
IH(3) = KHKL(3)
END IF
DO 12 J=1,5
IHKL(J) = IH(J)
12 CONTINUE
ELSE
C
C---- No reflection found within 4 pixels in X and Y
C
IHKL(1) = 0
IHKL(2) = 0
IHKL(3) = 0
IHKL(4) = 0
IHKL(5) = 1000
IRECG = -1
END IF
END
C== GETMOREBG ==
SUBROUTINE GETMOREBG(OD,LRAS,MASK,MASKREJ,PQSUMS,PQSUMINV,JBOX)
C =============================================================
IMPLICIT NONE
C
C---- Find more background points, selecting those with the lowest values
C in rejected background pixels.
C
C****** DEBUG(59) FOR THIS SUBROUTINE ******
C
C MASK The peak/background mask (input)
C MASKREJ List of rejected background pixels, which is UPDATED
C by this routine (input and returned updated)
C PQSUMS List of background sums, updated by this routine
C PQSUMINV Inverse of matrix based on PQSUMS, updated by this
C routine
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER JBOX
C ..
C .. Array Arguments ..
INTEGER OD(MAXBOX),MASK(MAXBOX),MASKREJ(NREJMAX),LRAS(5)
REAL PQSUMS(6),PQSUMINV(9)
C ..
C .. Local Scalars ..
INTEGER I,NXX,NYY,NXY,ICUT,IODMAX,NBG,P,Q,IHX,IHY,IJ,NREJB,IPT,
+ LREJ,K,IDR,MAXPIX,NBGWANT,NOWARN
REAL FRAC,SP,SQ,SPQ,SPP,SQQ,S,ORECLEVEL
C ..
C .. Local Arrays ..
INTEGER LMASKREJ(NREJMAX),MASKREJP(NREJMAX),LMASKREJP(NREJMAX)
INTEGER*2 LMASK(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL PQINV,ODPLOT4R
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,MIN,NINT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C ..
C .. Equivalences ..
C ..
SAVE
C
DATA NOWARN/0/
C
C
NXX = LRAS(1)
NYY = LRAS(2)
NXY = NXX*NYY
IODMAX = 0
IDR = 1
NREJB = MASKREJ(1)
NBG = NINT(PQSUMS(6))
NBGWANT = NINT(RECLEVEL*NBGMIN)
C
C---- First test that it is possible to get the desired number of
C background points.
C
IF ((NBG+NREJB).LE.NBGWANT) THEN
ORECLEVEL = RECLEVEL
2 RECLEVEL = 0.8*RECLEVEL
NBGWANT = NINT(RECLEVEL*NBGMIN)
IF ((NBG+NREJB).LE.NBGWANT) GOTO 2
C
IF (NOWARN.LT.10) THEN
WRITE(IOUT,FMT=6004) ORECLEVEL,NBGMIN,RECLEVEL
IF (ONLINE) WRITE(IOUT,FMT=6004) ORECLEVEL,NBGMIN,RECLEVEL
6004 FORMAT(/,/,1X,'***** ERROR *****',/,1X,'With the current ',
+ 'values for RECLEVEL (',F4.1,') and NBGMIN (',I3,
+ ')',/,1X,'it is not possible to recover enough',
+ ' background pixels for this spot',/,1X,'or ',
+ 'standard profile.',/,1X,'To allow the program',
+ ' to proceed, RECLEVEL has been reduced to',F4.1,
+ /,1X,'However, you should examine the measurement',
+ ' box and try to allow more',/,1X,'background.',
+ ' REMEMBER that if a RASTER keyword is supplied',
+ ' the overall',/,1X,'dimensions of the box are ',
+ 'NOT increased unless the keywords:',/,1X,'PROFILE',
+ ' NOFIXBOX are included.',/,/)
NOWARN = NOWARN + 1
END IF
WARN(28) = .TRUE.
END IF
IF (DEBUG(59)) THEN
WRITE(IOUT,FMT=6002) JBOX,NREJB
IF (ONLINE) WRITE(ITOUT,FMT=6002) JBOX,NREJB
6002 FORMAT(/1X,'Getting more background pixels for profile',
+ ' (or reflection)',I6,/,1X,'Initially',I4,
+ ' background pixels rejected')
MAXPIX = 0
MASKREJP(1) = 0
LMASKREJP(1) = 0
CALL ODPLOT4R(OD,NXX,NYY,IDR,MASK,MASKREJ,MASKREJP,LMASKREJP,
+ MAXPIX)
END IF
C
C---- Find maximum value in peak region of OD
C
DO 10 I = 1,NXY
LMASK(I) = 1
IF (MASK(I).EQ.1) IODMAX = MAX(IODMAX,OD(I))
10 CONTINUE
C
C---- Now find rejected background pixels with a value less than FRAC*IODMAX
C
FRAC = 0.0
20 FRAC = FRAC + 0.0025
LREJ = 0
ICUT = NINT(FRAC*IODMAX)
DO 30 I = 1,NREJB
IPT = MASKREJ(I+1)
IF (ABS(OD(IPT)).GT.ICUT) THEN
LREJ = LREJ + 1
LMASKREJ(LREJ+1) = IPT
END IF
30 CONTINUE
IF (DEBUG(59)) THEN
WRITE(IOUT,FMT=6010) FRAC,ICUT,LREJ
IF (ONLINE) WRITE(ITOUT,FMT=6010) FRAC,ICUT,LREJ
6010 FORMAT(1X,'FRAC now ',F7.4,' ICUT',I6,' Number rejected ',
+ 'pixels',I4)
END IF
IF ((PQSUMS(6)+(NREJB-LREJ)).LT.RECLEVEL*NBGMIN) GOTO 20
C
C---- Recovered enough background points, update MASKREJ, set LMASK zero
C for rejected background pixels.
C
DO 40 I = 2,LREJ+1
IPT = LMASKREJ(I)
MASKREJ(I) = IPT
LMASK(IPT) = 0
40 CONTINUE
MASKREJ(1) = LREJ
C
C---- Now set up PQSUMS and PQSUMINV for this box
C
IHX = NXX/2
IHY = NYY/2
IJ = 0
SP = 0.0
SQ = 0.0
SPQ = 0.0
SPP = 0.0
SQQ = 0.0
S = 0.0
DO 60 P = -IHX,IHX
DO 50 Q = -IHY,IHY
IJ = IJ + 1
C
C---- Select all NON-PEAK pixels which have not been
C rejected above
C
IF ((MASK(IJ).NE.1).AND.(LMASK(IJ).EQ.1)) THEN
C
C Background pixels
C
S = S + 1
SP = P + SP
SQ = Q + SQ
SPP = P*P + SPP
SQQ = Q*Q + SQQ
SPQ = P*Q + SPQ
END IF
50 CONTINUE
60 CONTINUE
PQSUMS(1) = SPP
PQSUMS(2) = SQQ
PQSUMS(3) = SPQ
PQSUMS(4) = SP
PQSUMS(5) = SQ
PQSUMS(6) = S
C
C **************************************
CALL PQINV(PQSUMS(1),PQSUMINV(1))
C **************************************
C
IF (DEBUG(59)) THEN
WRITE(IOUT,FMT=6030) JBOX,LRAS,MASKREJ(1),
+ (PQSUMS(K),K=1,6),(PQSUMINV(K),K=1,9)
IF (ONLINE) WRITE(ITOUT,FMT=6030) JBOX,LRAS,MASKREJ(1),
+ (PQSUMS(K),K=1,6),(PQSUMINV(K),
+ K=1,9)
6030 FORMAT(1X,'Box',I5,' Raster parameters',5I3,/,1X,
+ 'Number rejected background pixels',I4,/,1X,
+ 'PQSUMS',6F12.0,/,1X,'PQSUMINV',9F12.8)
END IF
C
C
END
C== GETOVR ==
SUBROUTINE GETOVR(IMAGE,NXPIX,NYPIX,NOVFL,NRECOVFL)
C
IMPLICIT NONE
C Read the overload records from end of file and replace
C appropriate pixels in array IMAGE. Only for MAR scanners
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NXPIX,NYPIX,NOVFL,NRECOVFL
C ..
C .. Array Arguments ..
INTEGER*2 IMAGE(NXPIX*NYPIX)
C ..
C .. Local Scalars ..
INTEGER I,J,NITEM,NPIX,IOD,INVPIX,IREC,JPIX,IPIX,IODOLD,
+ ISWAP,IERR,NNBYTES,NLEFT,NREAD
C ..
C .. Local Arrays ..
INTEGER IOVER(IYLENGTH/2)
C ..
C ..
C .. External Subroutines ..
EXTERNAL GETBLK,SHUTDOWN
C
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
C
IF (NRECOVFL.EQ.0) RETURN
C
C---- Turn off byte swapping in GETBLK
C
ISWAP = 1
NITEM = NYPIX/2
IERR = 0
NLEFT = NOVFL
C
C---- Read the overloads in "lots" of 200
C
10 NREAD = MIN(NLEFT,200)
NNBYTES = NREAD*8
C
CALL GETBLK(IOVER,NNBYTES,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6004) I
IF (ONLINE) WRITE(ITOUT,FMT=6004) I
6004 FORMAT(/,1X,'Error trying to read overload record',I3,
+ ' in image file.',/,1X,'Check that the file is',
+ ' the correct length.')
CALL SHUTDOWN
END IF
IF (BYTSWAP) CALL SWAPHDR(IOVER(1),NITEM)
C
C---- IOVER contains "pixel number, true counts" for all overloaded
C pixels
C
DO 20 J = 1,NREAD
IPIX = IOVER(2*J-1)
IOD = IOVER(2*J)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6000) IPIX,IOD
IF (ONLINE) WRITE(ITOUT,FMT=6000) IPIX,IOD
6000 FORMAT(1X,'Overload at pixel',I8,' value',I8)
END IF
C
C---- Do pixel number conversion to allow for the fact that images has
C been inverted left to right.
IREC = (IPIX/NYPIX)+1
JPIX = IPIX - (IREC-1)*NYPIX
INVPIX = (NXPIX-IREC)*NYPIX + JPIX
IODOLD = IMAGE(INVPIX)
IF (DEBUG(45)) THEN
IF (J.LT.10) THEN
WRITE(IOUT,FMT=6002) IPIX,IREC,JPIX,INVPIX,IODOLD
IF (ONLINE) WRITE(ITOUT,FMT=6002) IPIX,IREC,JPIX,
+ INVPIX,IODOLD
6002 FORMAT(1X,'IPIX,IREC,JPIX,INVPIX,IODOLD',5I7)
END IF
END IF
C
C---- Trap values greater than 262143 and set to 262143. These are saturated
C pixels
C
IOD = MIN(IOD,262143)
C
IMAGE(INVPIX) = -(IOD+4)/8
20 CONTINUE
C
NLEFT = NLEFT - NREAD
IF (NLEFT.GT.0) GOTO 10
RETURN
END
C== GETPIX ==
SUBROUTINE GETPIX(NDISP,IHKL,IXP,IYP,IFLAG)
C
C---- Finds display coordinates IXP,IYP for reflection with indices IHKL
C IFLAG = 0 Reflection found
C = 1 Reflection not found in list of displayed spots
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER NDISP,IXP,IYP,IFLAG
C ..
C .. Array Arguments ..
INTEGER IHKL(5)
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER I,J,IRECG,MP,KSYM
C ..
C .. Local Arrays ..
INTEGER IH(7),KHKL(3),HKLAU(3)
C ..
C .. External Subroutines ..
EXTERNAL GETHKL
C ..
C .. Extrinsic Functions ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C ..
C .. Equivalences ..
C
C ..
SAVE
C
C---- Find reflection with given indices
C
IFLAG = 0
DO 10 I = 1,NDISP
IRECG = IREC(I)
CALL GETHKL(IRECG,IH)
KHKL(1) = IH(1)
KHKL(2) = IH(2)
KHKL(3) = IH(3)
C
C---- If finding reflection after integration of image indices of all
C but rejected spots will have been reduced to asymmetric unit
C so need to recover original indices
C
MP = MISYMG(IRECG)
IF (MP.NE.0) THEN
HKLAU(1) = IH(1)
HKLAU(2) = IH(2)
HKLAU(3) = IH(3)
MP = MP/256
KSYM = MISYMG(IRECG) - MP*256
CALL ASUGET(HKLAU,KHKL,KSYM)
END IF
DO 12 J=1,3
IF (IHKL(J).NE.KHKL(J)) GOTO 10
12 CONTINUE
C
C---- Reflection found
C
IXP = IX(I)
IYP = IY(I)
RETURN
10 CONTINUE
C
C---- Reflection not found, return error status
C
IFLAG = 1
RETURN
END
C== GETPROF ==
SUBROUTINE GETPROF(IFLG,NSBOX,IPRNUM,WTPR,MASK,MASKREJ,IWTPROF,
+ PROFSUMS,WPROFSUMS,LMASKREJ,PQSUMSPOT,
+ PQSUMINVSPOT,XDEBUG)
C ===================================================================
IMPLICIT NONE
C
C---- Calculates the weighted profile from the 8 (or less) contributing
C profiles. When forming an averaged standard profile there may be up
C to 8 neighbours, when forming a variable profile for a particular
C reflection, there will be up to 4 ( less at outer edges of detector)
C
C IFLG = 1 when averaging the standard (weighted) profiles
C stored in WPROFL to get an acceptable standard profile.
C = 0 when averaging over profiles in IPROFL to get the optimum
C profile for evaluation of a particular reflection.
C
C NSBOX the standard profile number.
C IPRNUM contains the box numbers of the contributing profiles.
C WTPR contains their weights
C IWTPROF the weighted profile (returned).
C MASKREJ rejected background pixels for ALL boxes
C LMASKREJ combined list of rejected pixels for all profiles
C contributing to this one (Returned)
C PROFSUMS Profile sums (peak pixels only) for weighted profile (Returned)
C WPROFSUMS Profile sums (all pixels except rejected background)
C for weighted profile (Returned)
C PQSUMSPOT Sums involving background pixels (Returned)
C PQSUMINVSPOT Inverse of matrix fromed from PQSUMSPOT (Returned)
C
C****** DEBUG(36) FOR THIS SUBROUTINE ******
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NSBOX,IFLG
LOGICAL XDEBUG
C ..
C .. Array Arguments ..
INTEGER IPRNUM(9),MASK(MAXBOX),IWTPROF(MAXBOX),
+ MASKREJ(NREJMAX,NMASKS),LMASKREJ(NREJMAX)
REAL WTPR(9),PROFSUMS(4),WPROFSUMS(4),PQSUMSPOT(6),
+ PQSUMINVSPOT(9)
C ..
C .. Local Scalars ..
REAL WEIGHT,PR1,PR2,PR3,PR4,WPR1,WPR2,WPR3,WPR4,SPP,SQQ,SPQ,SP,
+ SQ,S
INTEGER I,IHX,IHY,IN,IPROFN,IV,J,K,KBOX,KNX,KNXY,KNY,N,
+ NCOMMONX,NCOMMONY,NDIFFX,NDIFFY,NP,NX,NXY,NY,
+ NYP,P,Q,IJ,NBREJ,IREJ,NREJ,KHX,KHY,NEXTREJ
LOGICAL BIGGERX,BIGGERY,ALLDONE
C ..
C .. Local Arrays ..
INTEGER LMASK(MAXBOX),IMASK(-MXDOV2:MXDOV2,-MXDOV2:MXDOV2),
+ NPRINT(9)
C ..
C .. External Subroutines ..
EXTERNAL PQINV,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,MIN,NINT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C
C
NX = ISIZE(NSBOX,1)
NY = ISIZE(NSBOX,2)
IHX = NX/2
IHY = NY/2
NXY = NX*NY
C
C---- Zero the new box
C
DO 2 I=1,MAXBOX
IWTPROF(I) = 0
LMASK(I) = 1
2 CONTINUE
DO 6 I = -MXDOV2,MXDOV2
DO 4 J = -MXDOV2,MXDOV2
IMASK(I,J) = 0
4 CONTINUE
6 CONTINUE
C
C---- Find number of profiles contributing
C
C
IF (DEBUG(36)) THEN
WRITE(IOUT,FMT=6000) NSBOX,IPRNUM,WTPR
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSBOX,IPRNUM,WTPR
END IF
6000 FORMAT(/,1X,'In GETPROF, NSBOX',I3,' Profile numbers:',9I5,
+ /,1X,'Weights: ',9F5.2)
C
C---- Now loop over profiles
C
DO 40 IV = 1,9
WEIGHT = WTPR(IV)
C
C---- In 3 profile case, weights can be negative !
C
IF (ABS(WEIGHT).LT.0.001) GOTO 40
N = 1
NP = 1
KBOX = IPRNUM(IV)
C
KNX = ISIZE(KBOX,1)
KNY = ISIZE(KBOX,2)
KHX = KNX/2
KHY = KNY/2
IJ = 0
NREJ = MASKREJ(1,KBOX)
C WRITE(6,*)'nrej for box',nrej,kbox
C WRITE(6,*)'khx,khy',khx,khy
IF (NREJ.EQ.0) GOTO 18
IREJ = 2
NEXTREJ = MASKREJ(IREJ,KBOX)
DO 16 I = -KHX,KHX
DO 14 J = -KHY,KHY
IJ = IJ + 1
IF (IJ.EQ.NEXTREJ) THEN
C WRITE(6,*)'found rejected pixel number at',irej-1,i,j
IMASK(I,J) = 1
IREJ = IREJ + 1
IF (IREJ-1.GT.NREJ) GOTO 18
NEXTREJ = MASKREJ(IREJ,KBOX)
END IF
14 CONTINUE
16 CONTINUE
C
18 KNXY = KNX*KNY
BIGGERX = (NX.GT.KNX)
BIGGERY = (NY.GT.KNY)
NDIFFX = ABS(NX-KNX)
NDIFFY = ABS(NY-KNY)
C
C---- Find start point along x
C
IF (BIGGERX) THEN
N = NDIFFX*NY/2 + N
ELSE
NP = NDIFFX*KNY/2 + NP
END IF
C
C---- Now on common x, find limits of common area
C
NCOMMONX = MIN(NX,KNX)
NCOMMONY = MIN(NY,KNY)
C
C---- Offset y ready to loop
C
IF (BIGGERY) THEN
N = N - NDIFFY/2
ELSE
NP = NP - NDIFFY/2
END IF
C
C
C IF (DEBUG(36)) THEN
C WRITE (IOUT,FMT=6002) NX,NY,KNX,KNY,NCOMMONX,NCOMMONY,
C + NDIFFX,NDIFFY,N,NP
C IF (ONLINE) WRITE (ITOUT,FMT=6002) NX,NY,KNX,KNY,NCOMMONX,
C + NCOMMONY,NDIFFX,NDIFFY,N,NP
C END IF
C
C---- Loop over common x
C
DO 30 I = 1,NCOMMONX
C
C---- First find common point along y
C
IF (BIGGERY) THEN
N = N + NDIFFY
ELSE
NP = NP + NDIFFY
END IF
C
C---- Loop over common y
C
DO 20 J = 1,NCOMMONY
IF (IFLG.EQ.0) THEN
IWTPROF(N) = IWTPROF(N) + WEIGHT*IPROFL(NP,KBOX)
ELSE IF (IFLG.EQ.1) THEN
IWTPROF(N) = IWTPROF(N) + WEIGHT*WPROFL(NP,KBOX)
END IF
C
C
IF ((N.GT.NXY) .OR. (NP.GT.KNXY)) THEN
GO TO 70
ELSE
C
C
C IF ((DEBUG(36)) .AND. (N.LT.30) .AND. SPOT) THEN
C WRITE (IOUT,FMT=6006) N,NP
C IF (ONLINE) WRITE (ITOUT,FMT=6006) N,NP
C END IF
C
C
N = N + 1
NP = NP + 1
END IF
20 CONTINUE
30 CONTINUE
40 CONTINUE
C
C---- End of loop over profiles, Now form new LMASKREJ which includes
C the rejected pixels of all contributing profiles. However only
C allow rejection of background pixels, not peak ones (test MASK).
C
NREJ = 0
IJ = 0
DO 44 I = -IHX,IHX
DO 42 J = -IHY,IHY
IJ = IJ + 1
IF ((IMASK(I,J).EQ.1).AND.(MASK(IJ).LT.1)) THEN
NREJ = NREJ + 1
C
C---- Trap too many rejected pixels
C WRITE(6,*)'overall rejection pixel at',nrej,i,j
IF (NREJ+1.GT.NREJMAX) THEN
WRITE(IOUT,FMT=6030) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6030) NREJMAX
CALL SHUTDOWN
END IF
LMASKREJ(NREJ+1) = IJ
LMASK(IJ) = 0
END IF
42 CONTINUE
44 CONTINUE
LMASKREJ(1) = NREJ
6030 FORMAT(//1X,'****** FATAL ERROR ******',/,1X,'More than ',I5,
+ ' Background pixels rejected due to overlap of ',
+ 'neighbouring',/,1X,'spots. Check that the minimum ',
+ 'allowed spot separation (SEPARATION keyword)',/,1X,'is ',
+ 'appropriate for this image...problems will arise if',
+ ' these values are',/,1X,'too small',/,1X,'If this is not',
+ ' the problem, try to reduce the overall size of the',/,1X,
+ 'measurement box. If profile optimisation is being used',
+ ' (this is the default)',/,1X,'then PROFILE RATIO keywords'
+ ,' determine how large the overall box will be.',/,1X,
+ 'Reduce RATIO to get a smaller box, or alternatively use',
+ ' PROFILE FIXBOX',/,1X,'keywords to prevent optimisation',
+ ' of the overall dimensions of the box.',
+ /,1X,'If this is not a',
+ ' viable option, change parameter NREJMAX to a larger ',
+ /,1X,'and recompile the program')
C
IF (DEBUG(36)) THEN
DO 45 I = 1,4
IV = IPRNUM(I)
NPRINT(I) = 0
IF (IV.GT.0) NPRINT(I) = MASKREJ(1,IV)
45 CONTINUE
WRITE(IOUT,FMT=6012) (NPRINT(IV),IV=1,4),
+ LMASKREJ(1)
IF (ONLINE) WRITE(ITOUT,FMT=6012) (NPRINT(IV),IV=1,4),
+ LMASKREJ(1)
END IF
6012 FORMAT(1X,'Number of rejected pixels for 4 profiles',4I5,
+ ' Number for weighted profile',I5)
C
C---- Now form PROFSUMS,and WPROFSUMS for this profile
C
N = 0
PR1 = 0.0
PR2 = 0.0
PR3 = 0.0
PR4 = 0.0
WPR1 = 0.0
WPR2 = 0.0
WPR3 = 0.0
WPR4 = 0.0
C
SPP = 0.0
SQQ = 0.0
SPQ = 0.0
SP = 0.0
SQ = 0.0
S = 0.0
CAL IF (XDEBUG) THEN
CAL WRITE(IOUT,FMT=6020)
CAL IF (ONLINE) WRITE(ITOUT,FMT=6020)
CAL 6020 FORMAT(1X,'The following is a list of all non-rejected ',
CAL + 'pixels.',/,1X,'P,Q are pixel coords with origin at',
CAL + ' lower left. IPR is profile value.',/,1X,
CAL + ' MASK = -1 for background, 1 for peak pixels',/,1X,
CAL + ' P Q IPR MASK')
CAL END IF
C
DO 60 P = -IHX,IHX
DO 50 Q = -IHY,IHY
N = N + 1
C
C---- These sums are for peak pixels only
C
IF (MASK(N).GT.0) THEN
IPROFN = IWTPROF(N)
IF (IPROFN.GT.15000) THEN
WRITE(6,*)'IPROFN TOO LARGE',IPROFN
WRITE(6,*)'NSBOX',NSBOX
WRITE(6,*)'IPRNUM',IPRNUM
WRITE(6,*)'WTPR',WTPR
END IF
PR1 = PR1 + P*IPROFN
PR2 = PR2 + Q*IPROFN
PR3 = PR3 + IPROFN
PR4 = PR4 + IPROFN*IPROFN
END IF
C
C---- These sums are over ALL pixels EXCEPT rejected background pixels
C
IF (LMASK(N).GT.0) THEN
IPROFN = IWTPROF(N)
WPR1 = WPR1 + P*IPROFN
WPR2 = WPR2 + Q*IPROFN
WPR3 = WPR3 + IPROFN
WPR4 = WPR4 + IPROFN*IPROFN
CAL IF (XDEBUG) THEN
CAL WRITE(IOUT,FMT=6022) P+IHX+1,Q+IHY+1,IPROFN,MASK(N)
CAL IF (ONLINE) WRITE(ITOUT,FMT=6022) P+IHX+1,Q+IHY+1,IPROFN,
CAL + MASK(N)
CAL END IF
END IF
6022 FORMAT(1X,2I4,I7,I6)
C
C---- These sums are for background pixels only
C
IF ((IFLG.EQ.0).AND.(MASK(N).LT.0).AND.(LMASK(N).GT.0)) THEN
SPP = SPP + P*P
SQQ = SQQ + Q*Q
SPQ = SPQ + P*Q
SP = SP + P
SQ = SQ + Q
S = S + 1.0
END IF
50 CONTINUE
60 CONTINUE
C
C---- New background sums for this spot
C
C WRITE(6,*)'SPP,SQQ,SQP,SP,SQ,S',SPP,SQQ,SPQ,SP,SQ,S
IF (IFLG.EQ.0) THEN
PQSUMSPOT(1) = SPP
PQSUMSPOT(2) = SQQ
PQSUMSPOT(3) = SPQ
PQSUMSPOT(4) = SP
PQSUMSPOT(5) = SQ
PQSUMSPOT(6) = S
C
C ****************************
CALL PQINV(PQSUMSPOT(1),PQSUMINVSPOT(1))
C ****************************
END IF
PROFSUMS(1) = PR1
PROFSUMS(2) = PR2
PROFSUMS(3) = PR3
PROFSUMS(4) = PR4
WPROFSUMS(1) = WPR1
WPROFSUMS(2) = WPR2
WPROFSUMS(3) = WPR3
WPROFSUMS(4) = WPR4
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6024) PR3,WPR3,S
IF (ONLINE) WRITE(ITOUT,FMT=6024) PR3,WPR3,S
6024 FORMAT(1X,'Sum of profile over peak pixels only',F12.0,/,1X,
+ 'Sum of profile over all non-rejected pixels ',F12.0,/,1X,
+ 'Number of non-rejected background pixels',F6.0)
END IF
C
IF (DEBUG(36).AND.SPOT) THEN
WRITE (IOUT,FMT=6008) PROFSUMS,WPROFSUMS
WRITE (IOUT,FMT=6010) (IWTPROF(K),K=1,NXY)
C
C
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6008) PROFSUMS,WPROFSUMS
WRITE (ITOUT,FMT=6010) (IWTPROF(K),K=1,NXY)
END IF
END IF
C
RETURN
C
C---- Error
C
70 IF (ONLINE) WRITE (ITOUT,FMT=6004) N,NP
WRITE (IOUT,FMT=6004) N,NP
CALL SHUTDOWN
C
C---- Format statements
C
6002 FORMAT (/1X,'NX,NY=',2I3,' KNX,KNY=',2I3,' NCOMMX,NCOMMY=',2I3,
+ ' NDIFFX,Y=',2I3,' START N,NP',2I4)
6004 FORMAT (1X,'In Subroutine GETPROF, The Pixel count (N or NP)is T',
+ 'OO Large, N=',I4,' NP=',I4,/1X,'Try DEBUG Option')
6006 FORMAT (1X,'Equivalenced pair',2I4)
6008 FORMAT (/1X,'Array profsums ',4F12.0,/,1X,'Array WPROFSUMS',4F12.0,
+ /,1X,'Averaged ods',/)
6010 FORMAT (1X,20I5)
C
C
END
C== GETREJ ==
SUBROUTINE GETREJ(NSBOX,IPASS,IPRNUM,MASK,MASKREJ,LMASKREJ)
C ===================================================================
IMPLICIT NONE
C
C---- Calculates composite list of rejected background pixels from the
C 8 (or less) contributing
C profiles. When forming an averaged standard profile there may be up
C to 8 neighbours.
C
C NSBOX is the standard profile for this spot.
C IPRNUM contains the box numbers of the contributing profiles.
C WTPR contains their weights
C IWTPROF is the weighted profile (returned).
C
C****** DEBUG(58) FOR THIS SUBROUTINE ******
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NSBOX,IFLG,IPASS
C ..
C .. Array Arguments ..
INTEGER IPRNUM(9),MASK(MAXBOX),
+ MASKREJ(NREJMAX,NMASKS),LMASKREJ(NREJMAX)
C ..
C .. Local Scalars ..
INTEGER I,IHX,IHY,IN,IPROFN,IV,J,K,KBOX,KNX,KNXY,KNY,N,
+ NCOMMONX,NCOMMONY,NDIFFX,NDIFFY,NP,NX,NXY,NY,
+ NYP,P,Q,IJ,NBREJ,IREJ,NREJ,KHX,KHY,NEXTREJ,NBOXES
LOGICAL BIGGERX,BIGGERY,ALLDONE
C ..
C .. Local Arrays ..
INTEGER IMASK(-MXDOV2:MXDOV2,-MXDOV2:MXDOV2)
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,MIN,NINT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C
C
NX = ISIZE(NSBOX,1)
NY = ISIZE(NSBOX,2)
IHX = NX/2
IHY = NY/2
NXY = NX*NY
C
DO 6 I = -MXDOV2,MXDOV2
DO 4 J = -MXDOV2,MXDOV2
IMASK(I,J) = 0
4 CONTINUE
6 CONTINUE
C
C---- Find number of profiles contributing
C
IF (IPASS.EQ.1) THEN
NBOXES = 5
ELSE
NBOXES = 9
END IF
C
IF (DEBUG(58)) THEN
WRITE(IOUT,FMT=6000) NSBOX,NBOXES,IPRNUM
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSBOX,NBOXES,IPRNUM
END IF
6000 FORMAT(/,1X,'In GETREJ, NSBOX',I3,' NBOXES',I3,
+ ' Profile numbers:',9I5)
C
C---- Now loop over profiles
C
DO 40 IV = 1,NBOXES
KBOX = IPRNUM(IV)
IF (KBOX.EQ.0) GOTO 40
C
KNX = ISIZE(KBOX,1)
KNY = ISIZE(KBOX,2)
KHX = KNX/2
KHY = KNY/2
IJ = 0
NREJ = MASKREJ(1,KBOX)
IF (NREJ.EQ.0) GOTO 40
IREJ = 2
NEXTREJ = MASKREJ(IREJ,KBOX)
DO 16 I = -KHX,KHX
DO 14 J = -KHY,KHY
IJ = IJ + 1
IF (IJ.EQ.NEXTREJ) THEN
C WRITE(6,*),'found rejected pixel number at',irej-1,i,j
IMASK(I,J) = 1
IREJ = IREJ + 1
IF (IREJ-1.GT.NREJ) GOTO 40
NEXTREJ = MASKREJ(IREJ,KBOX)
END IF
14 CONTINUE
16 CONTINUE
C
C
40 CONTINUE
C
C---- End of loop over profiles, Now form new LMASKREJ which includes
C the rejected pixels of all contributing profiles. However only
C allow rejection of background pixels, not peak ones (test MASK).
C
NREJ = 0
IJ = 0
DO 44 I = -IHX,IHX
DO 42 J = -IHY,IHY
IJ = IJ + 1
IF ((IMASK(I,J).EQ.1).AND.(MASK(IJ).LT.1)) THEN
NREJ = NREJ + 1
C
C---- Trap too many rejected pixels
C
IF (NREJ+1.GT.NREJMAX) THEN
WRITE(IOUT,FMT=6030) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6030) NREJMAX
CALL SHUTDOWN
END IF
C WRITE(6,*),'overall rejection pixel at',nrej,i,j
LMASKREJ(NREJ+1) = IJ
END IF
42 CONTINUE
44 CONTINUE
LMASKREJ(1) = NREJ
C
6030 FORMAT(//1X,'****** FATAL ERROR ******',/,1X,'More than ',I5,
+ ' Background pixels rejected due to overlap of ',
+ 'neighbouring',/,1X,'spots. Check that the minimum ',
+ 'allowed spot separation (SEPARATION keyword)',/,1X,'is ',
+ 'appropriate for this image...problems will arise if',
+ ' these values are',/,1X,'too small',/,1X,'If this is not',
+ ' the problem, try to reduce the overall size of the',/,1X,
+ 'measurement box. If profile optimisation is being used',
+ ' (this is the default)',/,1X,'then PROFILE RATIO keywords'
+ ,' determine how large the overall box will be.',/,1X,
+ 'Reduce RATIO to get a smaller box, or alternatively use',
+ ' PROFILE FIXBOX',/,1X,'keywords to prevent optimisation',
+ ' of the overall dimensions of the box.',
+ /,1X,'If this is not a',
+ ' viable option, change parameter NREJMAX to a larger ',
+ /,1X,'and recompile the program')
C
IF (DEBUG(58)) THEN
WRITE(IOUT,FMT=6012) (MASKREJ(1,IPRNUM(IV)),IV=1,4),
+ LMASKREJ(1)
IF (ONLINE) WRITE(ITOUT,FMT=6012)
+ (MASKREJ(1,IPRNUM(IV)),IV=1,4),LMASKREJ(1)
END IF
6012 FORMAT(1X,'Number of rejected pixels for 4 profiles',4I5,
+ ' Number for weighted profile',I5)
C
C---- Format statements
C
6002 FORMAT (/1X,'NX,NY=',2I3,' KNX,KNY=',2I3,' NCOMMX,NCOMMY=',2I3,
+ ' NDIFFX,Y=',2I3,' START N,NP',2I4)
6004 FORMAT (1X,'In Subroutine GETREJ, The Pixel count (N or NP)is T',
+ 'OO Large, N=',I4,' NP=',I4,/1X,'Try DEBUG Option')
6006 FORMAT (1X,'Equivalenced pair',2I4)
6010 FORMAT (1X,20I5)
C
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE GETSEPN(DSEP)
C ========================
C---- Determines the smallest possible spot separation on the detector given
C the spacegroup and crystal to detector distance. Used to determine if
C the "CLOSE" option is required. Note that the calculated separation
C is done using "precession" geometry and is therefore an absolute
C minimum...the actual separation could be at least 10% greater than this
C depending on the crystal orientation (ie if the long axis is along
C the rotation axis or normal to it). However it is adequate for the
C purpose of setting the CLOSE parameter.
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
REAL DSEP
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
REAL D1,D2,D3,DMIN,AL,SAL,CAL,AR,A,B,C,AST,BST,CST,
+ ALST,BEST,GAST,DTR
CHARACTER LATTYP*1
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
EQUIVALENCE (AST,RCELL(1)),(BST,RCELL(2)),(CST,RCELL(3)),
+ (ALST,RCELL(4)),(BEST,RCELL(5)),(GAST,RCELL(6)),
+ (A,CELL(1)),(B,CELL(2)),(C,CELL(3))
SAVE
C ..
C .. Data ..
C ..
C
C
C---- Get lattice type from spacegroup name
C
DTR = 4.0*ATAN(1.0)/180.0
LATTYP = SPGNAM(1:1)
C
IF ((LATTYP.EQ.'P').OR.((LATTYP.EQ.'R').AND.(ICRYST.EQ.8))
$ .OR.((LATTYP.EQ.'H').AND.(ICRYST.EQ.8))) THEN
DMIN = MIN(AST,BST,CST)
ELSE IF (LATTYP.EQ.'C') THEN
D1 = AST**2 + BST**2 + 2.0*AST*BST*COS(DTR*GAST)
D2 = D1 - 4.0*AST*BST*COS(DTR*GAST)
D1 = SQRT(D1)
D2 = SQRT(D2)
DMIN = MIN(D1,D2,CST)
ELSE IF (LATTYP.EQ.'I') THEN
D1 = SQRT(0.5*(AST**2+BST**2))
D2 = SQRT(0.5*(BST**2+CST**2))
D3 = SQRT(0.5*(AST**2+CST**2))
DMIN = MIN(D1,D2,D3)
ELSE IF (LATTYP.EQ.'F') THEN
D1 = SQRT(AST**2 + BST**2 + CST**2)
DMIN = MIN(2*AST,A*BST,2*CST,D1)
ELSE IF (LATTYP.EQ.'H') THEN
AR = (3.0*A**2 + C**2)/9.0
IF (AR.GT.0.0) THEN
CAL = (2.0*C**2 - 3.0*A**2)/(18.0*AR)
AR = SQRT(AR)
AL = ACOS(CAL)
SAL = SIN(AL)
D1 = SAL/(AR*SQRT(1.0-3.0*CAL**2+2.0*CAL**3))
DMIN = D1
ELSE
DMIN = 0.0
END IF
ELSE IF (LATTYP.EQ.'U') THEN
DMIN = MIN(AST,BST,CST)
WRITE(IOUT,FMT=1000)
IF (ONLINE) WRITE(ITOUT,FMT=1000)
ELSE
DMIN = MIN(AST,BST,CST)
WRITE(IOUT,FMT=1002) LATTYP
IF (ONLINE) WRITE(ITOUT,FMT=1002) LATTYP
END IF
1000 FORMAT(1X,'***** WARNING *****',1X,'Lattice type',
+ ' not specified, so assumed primitive')
1002 FORMAT(1X,'***** WARNING *****',1X,'Lattice type ',A,
+ ' not specified, so assumed primitive')
DSEP = DMIN*XTOFD*0.01
RETURN
END
SUBROUTINE GETSEPRAS(IRAST,ISEP,IRAS,ID,MINDTX,MINDTY,IXSEP,
+ IYSEP,MODE,IERR)
C ==========================================================
C
IMPLICIT NONE
C
C---- Determine raster parameters and spot separation values based on size
C of spots in the centre of the image.
C
C MODE 0 Normal call
C 1 Just get separation, do not set CLOSE option, used to
C set a minimum separation for spot finding
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
INTEGER IRAST,ISEP,ID,MINDTX,MINDTY,IXSEP,IYSEP,MODE,IERR
C
C ..
C .. Array Arguments ..
INTEGER IRAS(5)
C ..
C .. Local Scalars ..
INTEGER MODESP,IXYSEP,I
REAL RAD,XSEP,YSEP,DSEP
LOGICAL LPRNT,CLOSE,BOXOPEN
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm2.h
C---- START of include file parm2.h
C
C
C .. Scalars in common block /PARM2/ ..
REAL PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2
LOGICAL PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,PUPDATE,PKONLY,DENSE,PRFULLS,
+ DECONV
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
INTEGER IHD
C ..
C .. Common Block /PARM2/ ..
COMMON /PARM2/PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,
$ PKWDLIM3,PKWDOUTL,
$ ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2,
$ IHD(3,50),
$ PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,
+ PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,
+ PUPDATE,PKONLY,DENSE,
+ PRFULLS,DECONV
C ..
C
C
C&&*&& end_include ../inc/parm2.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
6000 FORMAT(/,1X,'Determining average spot size for spots',
+ ' in centre of image.',/,1X,
+ '=======================================',
+ '===================')
MODESP = 20
IF (ITHSET.GT.0) MODESP = 30
LPRNT = .FALSE.
BOXOPEN = .FALSE.
THRESHMIN = 0.0
10 CALL GETSPOTS(MODESP,ID,LPRNT,BOXOPEN,IERR)
C
C---- Trap error in background determination
C
IF (IERR.GT.0) THEN
RAD = IERR*RAST
WRITE(IOUT,6010) RAD
IF (ONLINE) WRITE(ITOUT,6010) RAD
6010 FORMAT(1X,'Too few pixels with non-zero values at',
+ ' radius',F6.1,'mm, change keywords:',
+ ' SPOTS RMIN OR RMAX',/,1X,'or set separation',
+ ' or measurement box parameters with keyword input.')
RETURN
ELSE IF (IERR.EQ.-1) THEN
WRITE(IOUT,FMT=6020)
IF (ONLINE) WRITE(ITOUT,FMT=6020)
6020 FORMAT(1X,'*** ERROR ***',/,1X,'Too few spots found to set',
+ ' separation or measurement box parameters, set',/,1X,
+ 'them using keyword input, or change parameters',
+ ' of search using SPOTS keyword.')
RETURN
C
C---- Trap too many spots found (threshold too low)
C
ELSE IF (IERR.EQ.-2) THEN
THRESH = MAX(1.0,(THRESH + 0.5*THRESH))
WRITE(IOUT,FMT=6022) THRESH
IF (ONLINE) WRITE(ITOUT,FMT=6022) THRESH
THRESHMIN = THRESH
IF (THRESH.LT.1000) GOTO 10
6022 FORMAT(/,1X,'Threshold increased to:',F8.1)
END IF
C
C IF (MODE.EQ.1) GOTO 20
C
C----- Use median spot size to determine raster params and separation.
C
IF (IRAST.EQ.0) THEN
IRAST = 1
IRAS(1) = 2*MEDWXSPOT + 5
IRAS(2) = 2*MEDWYSPOT + 5
IRAS(3) = (MEDWXSPOT+MEDWYSPOT)/2 + 4
IRAS(4) = MEDWXSPOT/2 + 2
IRAS(5) = MEDWYSPOT/2 + 2
I = 0
IF (IRAS(1).LE.19) THEN
IRAS(1) = IRAS(1) + 2
IRAS(4) = IRAS(4) + 1
I = 1
END IF
IF (IRAS(2).LE.19) THEN
IRAS(2) = IRAS(2) + 2
IRAS(5) = IRAS(5) + 1
I = 1
END IF
IF (I.EQ.1) IRAS(3) = IRAS(3) + 1
WRITE(IOUT,FMT=6030) MEDWXSPOT,MEDWYSPOT,IRAS
IF (ONLINE) WRITE(ITOUT,FMT=6030) MEDWXSPOT,
+ MEDWYSPOT,IRAS
6030 FORMAT(/,1X,'Based on a median spot size of',I3,' by',I3,
+ ' pixels in X and Y, the measurement box ',/,1X,
+ 'parameters have been set to',5I4)
IF (.NOT.NOFIXBOX) FIXBOX = .TRUE.
IF (FIXBOX) THEN
WRITE(IOUT,FMT=6040)
IF (ONLINE) WRITE(ITOUT,FMT=6040)
6040 FORMAT(1X,'The overall size of the box has been fixed.'/,1X,
+ 'To prevent this use keywords PROFILE NOFIXBOX.')
END IF
END IF
C
C---- Now spot separation
C
20 IF (ISEP.EQ.0) THEN
ISEP = 1
IXSEP = 100*RAST*(MEDWXSPOT+2)
IYSEP = 100*RAST*(MEDWYSPOT+2)
C
C---- Now get the actual spot separation on the detector
C
CALL GETSEPN(DSEP)
C
C---- Convert spot separations (IXSEP,IYSEP) into "ideal detector" coordinate
C frame, as the spot coordinates (generate file coords) are in this frame
C
24 WRITE(IOUT,FMT=6050) MEDWXSPOT,MEDWYSPOT,
+ 0.01*IXSEP,0.01*IYSEP,DSEP
IF (ONLINE) WRITE(ITOUT,FMT=6050) MEDWXSPOT,
+ MEDWYSPOT,0.01*IXSEP,0.01*IYSEP,DSEP
6050 FORMAT(/,1X,'Based on a median spot size of',I3,' by',I3,
+ ' pixels in X and Y, the spot separation ',/,1X,
+ 'parameters (in X and Y) have been set to',2F6.2,'mm.',
+ /,1X,'Closest possible spot separation is',F6.2,'mm.')
MINDTX = NINT(ABS(IXSEP*COSOM0 + IYSEP*SINOM0))
MINDTY = NINT(ABS(IYSEP*COSOM0 + IXSEP*SINOM0))
C
IF (MODE.EQ.1) RETURN
C
C---- Now determine if the "CLOSE" option is needed.
C
IXYSEP = MAX(IXSEP,IYSEP)
CLOSE = (DSEP.LT.(0.01*IXYSEP+ISAFE*RAST))
IF (CLOSE) THEN
DENSE = .TRUE.
PKONLY = .TRUE.
WRITE(IOUT,FMT=6052) ISAFE
IF (ONLINE) WRITE(ITOUT,FMT=6052) ISAFE
6052 FORMAT(/,1X,'Because the minimum possible spot separation',
+ ' is less than the estimated spot',/,1X,'size plus a safety',
+ ' margin of',I2,' pixels (set by keywords SPOTS SAFE) ',
+ 'the',/,1X,'"CLOSE" option for integration has been set.',
+ /,1X,'****************************************************',
+ /,1X,'****************************************************',
+ /,1X,'It is advisable to ensure that all images for this',
+ ' dataset are also',/,1X,'processed using the "CLOSE" ',
+ 'option by explicitly including keywords:',/,1X,
+ 'SEPARATION CLOSE'
+ /,1X,'****************************************************',
+ /,1X,'****************************************************')
END IF
END IF
END
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== GETSPOTS ==
SUBROUTINE GETSPOTS(MODE,ID,LPRNT,BOXOPEN2,IERR)
IMPLICIT NONE
C
C
C MODE = 0 Determine background and find spots.
C = 1 Don't repeat background determination, just reset using
C new threshold
C = 2 Don't repeat spot search, just apply new limits
C = 10 Prelim search to determine best threshold for
C subsequent spot search
C = 20 Prelim search to determine best threshold, separation
C and raster box size, do not go on to search for spots
C on whole image.
C = 30 Used when getting separation and raster box params
C using supplied threshold. Only find spots in central
C area.
C
C
C ID Image number
C
C LPRNT = TRUE Print radial background and stats on found spots
C FALSE No printing
C
C IERR Error flag (returned)
C = 0 No error
C > 0 Error in background determination in stripe IERR
C = -1 Not enough spots found to determine raster and
C separation parameters. (Only set when MODE=20)
C = -2 Too many spots found (threshold too low)
C = -3 Too many spots to store
C = -4 No spots found at all
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE,ID,IERR
LOGICAL LPRNT,BOXOPEN2
C ..
C .. Local Scalars ..
INTEGER I,ISAVE,IFAIL,NCH,IPASS,ISTAT
REAL SIGAVG,TH1,TH2
LOGICAL EOF,NULINE
C ..
C .. Local Arrays ..
REAL THRESHA(5)
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL RADBG,RADBGY,PICKSPOTS
C ..
C .. Common blocks ..
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
CAL include '../inc/fid.f'
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C ..
SAVE
C
EOF = .FALSE.
IPASS = 0
IERR = 0
C
C
C---- Assign PHIIMG, passed through /SPOTS/ to WSPOT for writing output
C
C
C---- If called from CONTROL, IIMAG not yet assigned !
C
IF (IIMAG.EQ.0) THEN
IIMAG = 1
CAL PHI(1) = 0.5*(PHIBEG+PHIEND)
END IF
PHIIMG = PHI(IIMAG)
C
C
C
C---- If in BRIEF mode, open output file
C
IF (MODE.GE.10) THEN
IF (RMINSRCH.EQ.0) RMINSRCH = MAX(0.01*RMIN,ABS(RMINSP))
IF (RMAXSRCH.EQ.0) RMAXSRCH = RMINSRCH + (0.15*NREC*RAST)
IF (RMINSP.LT.0) RMINSRCH = -RMINSRCH
IF (RMAXSP.LT.0) RMAXSRCH = -RMAXSRCH
IF (MODE.EQ.30) THEN
WRITE(IOUT,FMT=6010) RMINSRCH,RMAXSRCH,NSEARCH
IF (ONLINE) WRITE(ITOUT,FMT=6010)
+ RMINSRCH,RMAXSRCH,NSEARCH
6010 FORMAT(1X,'Finding spot size around direct beam position',/,
+ 1X,'Default parameters may be reset with SPOTS keyword.',
+ /,1X,'Minimum radius',F6.1,'mm, maximum radius',F6.2,
+ 'mm, minimum number of spots',I3)
ELSE
WRITE(IOUT,FMT=6012) RMINSRCH,RMAXSRCH,NSEARCH
IF (ONLINE) WRITE(ITOUT,FMT=6012)
+ RMINSRCH,RMAXSRCH,NSEARCH
6012 FORMAT(1X,'Determining best threshold for spot finding.',/,1X,
+ 'Default parameters may be reset with SPOTS keyword.',
+ /,1X,'Minimum radius',F6.1,'mm, maximum radius',F6.2,
+ 'mm, minimum number of spots',I3)
END IF
LPRNT = .FALSE.
IF (DEBUG(62)) LPRNT = .TRUE.
END IF
C
10 IF (LPRNT) WRITE (IOUT,FMT=6002) ID,PHI(IIMAG)
IF (ONLINE.AND.LPRNT) WRITE (ITOUT,FMT=6002) ID,PHI(IIMAG)
6002 FORMAT (//1X,'Finding spots on image ',I5,' (Midpoint of phi',
+ F8.3,' degrees)')
C
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
IF (RADX) THEN
C
C---- Determine radial background in X
C ******
CALL RADBG(MODE,LPRNT,SIGAVG,IERR)
C ******
ELSE
C
C---- Determine radial background in Y
C ******
CALL RADBGY(MODE,LPRNT,SIGAVG,IERR)
C ******
END IF
C
C---- Trap error from extremely odd beam position
C
IF(IERR.EQ.-1)THEN
IF(INVERTX)THEN
WRITE(IOUT,FMT=6016)(NREC*RAST)-XCENMM(1,1),
$ YCENMM(1,1)
IF(ONLINE)WRITE(ITOUT,FMT=6016)
$ (NREC*RAST)-XCENMM(1,1),YCENMM(1,1)
IF(WINOPEN)THEN
WRITE(IOLINE,FMT=6016)(NREC*RAST)-XCENMM(1,1),
$ YCENMM(1,1)
CALL WINDIO(NULINE)
ENDIF
ELSE
WRITE(IOUT,FMT=6016)XCENMM(1,1),YCENMM(1,1)
IF(ONLINE)WRITE(ITOUT,FMT=6016)XCENMM(1,1),YCENMM(1,1)
IF(WINOPEN)THEN
WRITE(IOLINE,FMT=6016)XCENMM(1,1),YCENMM(1,1)
CALL WINDIO(NULINE)
ENDIF
ENDIF
6016 FORMAT(3(/,'***** WARNING *****'),/,
$ ' Your direct beam co-ordinates (',F10.2,1X,F10.2,
$ ')',/,' may be incorrect.',/,
$ ' CHECK the values supplied with your BEAM keyword',
$ ' or',/,' in the Processing parameters window')
RETURN
ENDIF
C
C---- Trap error in background determination
C
IF (IERR.NE.0) RETURN
C
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C **********
CALL PICKSPOTS(MODE,LPRNT,SIGAVG,BOXOPEN2,ISTAT)
C **********
C---- Check for error return
C
C too many spots...
C
IF (ISTAT.EQ.-3) THEN
IERR = -2
RETURN
C
C too many spots to store...
C
ELSE IF (ISTAT.EQ.-4) THEN
IERR = -3
RETURN
END IF
C
C insufficient spots for threshold determination
C
IF (ISTAT.EQ.-1) THEN
WRITE(IOUT,FMT=6020)
IF (ONLINE) WRITE(ITOUT,FMT=6020)
6020 FORMAT(1X,'*** ERROR ***',/,1X,'Too few spots found ',
+ 'to determine best threshold, use default value.',/,1X,
+ '(Use SPOTS keyword to reset default parameters used ',
+ ' in determining threshold..see help library.')
IF (MODE.GE.20) THEN
IERR = -1
RETURN
END IF
MODE = 0
LPRNT = .TRUE.
GOTO 10
C
C no spots found on image
C
ELSE IF (ISTAT.EQ.-2) THEN
IERR = -4
RETURN
END IF
C
C---- store threshold this pass
C
THRESHA(IPASS+1) = THRESH
C
C---- If this preliminary run to find threshold, repeat search with new
C threshold, have to redetermine background over proper limits
C
IF ((MODE.EQ.10).OR.(MODE.EQ.20)) THEN
IPASS = IPASS + 1
IF (IPASS.GT.1) THEN
TH1 = THRESHA(IPASS-1)
TH2 = THRESHA(IPASS)
C
C---- If the threshold has increased by more than 50% in the second pass
C do a third pass.
C
IF (((TH2-TH1)/TH1.GT.0.5) .AND.(IPASS.LT.3)) GOTO 10
ITHSET = 1
C
C---- If only want central spots to set separation and raster, return
C
IF (MODE.GE.20) RETURN
C
C---- Change mode to find spots on whole image
C
MODE = 0
LPRNT = .TRUE.
END IF
GOTO 10
C
C---- If a threshold has been supplied, return now
C
ELSE IF (MODE.EQ.30) THEN
RETURN
END IF
C
RETURN
END
C== GETSTRIP ==
SUBROUTINE GETSTRIP(NPBOX,ISTRIP)
C
C---- Returns ISTRIP, the number of the strip (in Y (fast changing)
C direction) containing the standard profile with number NPBOX
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NPBOX,ISTRIP
C .. Common blocks ..
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C
ISTRIP = (NPBOX-1)/(NYLINE-1) + 1
RETURN
END
C== GETTAIL ==
SUBROUTINE GETTAIL(NXPIX,NYPIX,IWAVE,IDIST)
C
IMPLICIT NONE
C Read the tailer record (s) from the image file.
C For DIP2000 images
C
C NXPIX Number of pixels in slow direction in image
C NYPIX Number of pixels in fast direction in image
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NXPIX,NYPIX,IWAVE,IDIST
C
C .. Local Scalars ..
INTEGER I,IERR,NXPIXO,NITEM,NNBYTE,ISWAP,NLXPIX,NLYPIX,IADCTYP
LOGICAL FIRST
C ..
C ..
C .. Local Arrays ..
REAL RHEAD(IYLENGTH/2)
CHARACTER TEXT(IYLENGTH/2)*4
C ..
C .. External Functions ..
LOGICAL LITEND
EXTERNAL LITEND
C ..
C .. External Subroutines ..
EXTERNAL GETBLK,SWAPHDR,SHUTDOWN
C
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C ..
C .. Equivalences ..
EQUIVALENCE (RHEAD(1),IHEAD(1))
EQUIVALENCE (TEXT(1),IHEAD(1))
SAVE
DATA FIRST/.TRUE./
C
ISWAP = 1
NITEM = 100
NNBYTE = 1024
IERR = 0
CALL GETBLK(IHEAD(1),NNBYTE,1,ISWAP,IERR)
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6006)
IF (ONLINE) WRITE(ITOUT,FMT=6006)
6006 FORMAT(/,1X,'Error trying to read tail record',
+ ' in image file.',/,1X,'Check that the file is',
+ ' the correct length')
CALL SHUTDOWN
END IF
IF (BYTSWAP) CALL SWAPHDR(IHEAD(1),NITEM)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6000) (IHEAD(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6000) (IHEAD(I),I=1,NITEM)
WRITE(IOUT,FMT=6002) (RHEAD(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6002) (RHEAD(I),I=1,NITEM)
WRITE(IOUT,FMT=6004) (TEXT(I),I=1,NITEM)
IF (ONLINE) WRITE(ITOUT,FMT=6004) (TEXT(I),I=1,NITEM)
6000 FORMAT(1X,'Tail record as integers elements 1-NITEM',/,
+ (1X,10I12))
6002 FORMAT(1X,'Tail record as reals elements 1-NITEM',/,
+ (1X,10F12.3))
6004 FORMAT(1X,'Tail record as characters 1-NITEM',/,(1X,10A))
END IF
IADCTYP = IHEAD(4)
CHRP for Atsushi Nakagawa IF (IADCTYP.GT.100) MODEL = '16BIT'
IF (.NOT.SETADC) THEN
IF (IADCTYP.GE.100) THEN
MODEL='16BIT'
ELSE IF (MOD(IADCTYP,3).EQ.1) THEN
MODEL='16BITD'
ELSE IF (MOD(IADCTYP,3).EQ.0) THEN
MODEL='12BIT'
ELSE
MODEL='16BITS'
END IF
END IF
NLXPIX = IHEAD(8)
NLYPIX = IHEAD(8)
HWAVE = RHEAD(31)
HDIST = RHEAD(32)
HPHIS = RHEAD(49)
HPHIE = RHEAD(50)
IF (DEBUG(45)) THEN
WRITE(IOUT,FMT=6010) MODEL,NLXPIX,NLYPIX,
+ HWAVE,HDIST,HPHIS,HPHIE
IF (ONLINE) WRITE(ITOUT,FMT=6010) MODEL,NLXPIX,NLYPIX,
+ HWAVE,HDIST,HPHIS,HPHIE
6010 FORMAT(/,/,1X,'ADC type: ',A,' No of pixels in X,Y',2I6,
+ ' wavelength',F8.5,' distance',F8.2,' start phi',
+ F8.2,' end phi',F8.2)
END IF
C
C---- Check wavelength and distance for consistency with values in header
C
IF ((XTOFD.NE.0.0).AND.(ABS(0.01*XTOFD - HDIST).GT.0.1)) THEN
WRITE(IOUT,FMT=6012) 0.01*XTOFD, HDIST
IF (ONLINE) WRITE(ITOUT,FMT=6012) 0.01*XTOFD, HDIST
END IF
6012 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'Input crystal to detector distance (',F7.2,
+ 'mm) does NOT agree with value in the image ',
+ 'header (',F7.2,'mm)',/,1X,'The input distance',
+ ' will be used')
C
C---- If distance not specified, set to value from header
C
IF (XTOFD.EQ.0.0) THEN
XTOFD = 100.0*HDIST
IDIST = 1
IF (FIRST) THEN
WRITE(IOUT,FMT=6030) 0.01*XTOFD
IF (ONLINE) WRITE(ITOUT,FMT=6030) 0.01*XTOFD
END IF
END IF
6030 FORMAT(/1X,'Detector distance from image tailer ',F7.2,'mm')
C
C---- Check wavelength
C
IF (IWAVE.GT.0) THEN
IF (ABS(WAVE - HWAVE).GT.0.001) THEN
WRITE(IOUT,FMT=6032) WAVE,HWAVE
IF (ONLINE) WRITE(ITOUT,FMT=6032) WAVE,HWAVE
END IF
ELSE
WAVE = HWAVE
IWAVE = 1
IF (FIRST) THEN
WRITE(IOUT,FMT=6034) WAVE
IF (ONLINE) WRITE(ITOUT,FMT=6034) WAVE
END IF
END IF
6032 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'Input wavelength (',F6.4,
+ 'A) does NOT agree with value in the image ',
+ 'header (',F6.4,'A)',/,1X,'The input wavelength',
+ ' will be used')
6034 FORMAT(/1X,'Wavelength from image tailer ',F8.4)
C
C---- If angle not specified, use those from header
C
IF (PHI(1).EQ.0) THEN
PHIBEG = HPHIS
PHIEND = HPHIE
PHI(1) = 0.5*(PHIBEG+PHIEND)
PHISTIM(1) = PHIBEG
WRITE(IOUT,FMT=6040) HPHIS,HPHIE
IF (ONLINE) WRITE(ITOUT,FMT=6040) HPHIS,HPHIE
6040 FORMAT(/,1X,'Start and end phi values for ',
+ 'this image from image header are ',F8.2,
+ ' and',F8.2,' degrees.')
ELSE
C
C---- Check that oscillation angle agrees
C
IF (ABS(2.0*(PHI(1)-PHISTIM(1)) -
+ (HPHIE-HPHIS)).GT.0.01) THEN
WRITE(IOUT,FMT=6042)
+ 2.0*(PHI(1)-PHISTIM(1)),(HPHIE-HPHIS)
IF (ONLINE) WRITE(ITOUT,FMT=6042)
+ 2.0*(PHI(1)-PHISTIM(1)),(HPHIE-HPHIS)
6042 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,1X,
+ 'Input oscillation angle of ',F8.3,' degrees',
+ ' does not agree with value from image header',
+ /,1X,'which gives',F8.3,' degrees',/,1X,
+ 'The input values will be used')
END IF
END IF
FIRST = .FALSE.
RETURN
END
C== GETYIND ==
SUBROUTINE GETYIND(NPBOX,NY)
C
C---- Returns NY, the Y index (runs from 1 to NYLINE-1) for
C the standard profile with number NPBOX
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NPBOX,NY
C ..
C .. Intrinsic Functions ..
INTRINSIC MOD
C .. Common blocks ..
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C
NY = MOD(NPBOX,NYLINE-1)
IF (NY.EQ.0) NY = NYLINE - 1
RETURN
END
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C 26-Nov-1988 J. W. Pflugrath Cold Spring Harbor Laboratory
C Edited to conform to Fortran 77. Renamed from Goniostat_3_compose to
C GN3CMP
C
C =============================================================================
C ! to compose rotation matrix for general 3-circle geometry
SUBROUTINE GN3CMP
C ! inputs: goniostat angles
1 (ANGLE1, ANGLE2, ANGLE3
C ! inputs: goniostat axes at datum position
2 , AXIS1, AXIS2, AXIS3
C ! input: maximum possible number of derivatives
3 , NDERMX
C ! input: required number of derivatives
4 , NDER
C ! outputs: rotation matrix and derivatives
5 , MATS)
IMPLICIT NONE
C
CEE Composes the rotation matrix for a 3-circle goniostat and
C any number of derivatives with respect to the angles of rotation.
C Goniostat_3_compose
Created: 14-NOV-1986 D.J.Thomas, MRC Laboratory of Molecular Biology,
C Hills Road, Cambridge, CB2 2QH, England
C Goniostat_3_compose
C
C ! 1st goniostat angle (usually omega) / radians
REAL ANGLE1
C ! 2nd goniostat angle (usually kappa/chi) / radians
REAL ANGLE2
C ! 3rd goniostat angle (usually phi) / radians
REAL ANGLE3
C ! dummy variable in statement function
INTEGER ORDER
C ! ORDER of derivative of product matrix wrt ANGLE1
INTEGER ORDER1
C ! ORDER of derivative of product matrix wrt ANGLE2
INTEGER ORDER2
C ! ORDER of derivative of product matrix wrt ANGLE3
INTEGER ORDER3
C ! number of derivatives required
INTEGER NDER
C ! maximum possible number of derivatives
INTEGER NDERMX
C ! statement function
INTEGER PRNPAL
C Goniostat_3_compose
C
C ! 1st axis (usually omega) (right-handed unit-vector)
REAL AXIS1 (1:3)
C ! 2nd axis (usually kappa/chi) (right-handed unit-vector)
REAL AXIS2 (1:3)
C ! 3rd axis (usually phi) (right-handed unit-vector)
REAL AXIS3 (1:3)
C ! overall rotation matrix and requested derivatives
REAL MATS (1:3, 1:3, 0:NDERMX, 0:NDERMX, 0:NDERMX)
C ! 1st angle rotation matrix and requested derivatives
REAL MATS1 (1:3,1:3,0:4)
C ! 2nd angle rotation matrix and requested derivatives
REAL MATS2 (1:3,1:3,0:4)
C ! 3rd angle rotation matrix and requested derivatives
REAL MATS3 (1:3,1:3,0:4)
C ! statement function to cycle round derivatives correctly
PRNPAL(ORDER) = 1+MOD(ORDER-1,4)
C
C ! make rotation matrix and requested derivatives (not > 4th)
CALL RTMATS(ANGLE1, AXIS1, MIN(NDER,4), MATS1)
C ! make rotation matrix and requested derivatives (not > 4th)
CALL RTMATS(ANGLE2, AXIS2, MIN(NDER,4), MATS2)
C ! make rotation matrix and requested derivatives (not > 4th)
CALL RTMATS(ANGLE3, AXIS3, MIN(NDER,4), MATS3)
C
DO 120 ORDER1 = 0, NDER
DO 110 ORDER2 = 0, NDER-ORDER1
DO 100 ORDER3 = 0, NDER-ORDER1-ORDER2
C
C! calculate all of the derivatives of the rotation matrix
C! up to the requested ORDER
C
CALL ML3MAT(
2 3, MATS1(1,1,PRNPAL(ORDER1)),
3 3, MATS2(1,1,PRNPAL(ORDER2)),
4 3, MATS3(1,1,PRNPAL(ORDER3)),
5 3, MATS(1,1,ORDER1,ORDER2,ORDER3))
100 CONTINUE
110 CONTINUE
120 CONTINUE
C
RETURN
END
C== GRADMEAN ==
SUBROUTINE GRADMEAN(IOD,IH,IRIM,GRAD)
C ===================================
IMPLICIT NONE
C
C---- Find the mean gradient in peak region of IOD. The halfwidth of
C the box is IH, IRIM is number of background points.
C ..
C .. Scalar Arguments ..
INTEGER IH,IRIM
REAL GRAD
C ..
C .. Array Arguments ..
INTEGER IOD(-IH:IH)
C ..
C .. Local Scalars ..
REAL GRADS,GRADP,GRADN
INTEGER I,NPT
LOGICAL POS,NEG
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
C---- Number of gradients to calculate (on each side of centre)
C
NPT = IH - IRIM
C
C
GRADS = 0.0
DO 30 I = 1,NPT
GRADP = IOD(I-1) - IOD(I)
GRADN = IOD(-I+1) - IOD(-I)
GRADS = GRADS + GRADP + GRADN
30 CONTINUE
GRAD = GRADS/REAL(2*NPT)
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== GROUT ==
SUBROUTINE GROUT
C
IMPLICIT NONE
C
C---- Write output for xloggraph to summary file
C
C
C Common block PARAMETER
C .. Include files ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER I
LOGICAL FIRST
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C ..
SAVE
C .. Data statements ..
DATA FIRST/.TRUE./
C
IF (FIRST) THEN
NSUMSTART1 = 1
NSUMSTART2 = 1
FIRST = .FALSE.
END IF
WRITE(ISUMMR,FMT=6000)
6000 FORMAT(1X,'$TABLE: Refined detector parameters:'
+ ,/,1X,'$GRAPHS ',
+ ':Camera constants CCX CCY CCOM v image:A:1,2,3,4: ',/,1X,
+ ':Distance v image:A:1,5:',/,1X,
+ ':Yscale v image:A:1,6:',/,1X,
+ ':Tilt and twist v image:A:1,7,8:',/,1X,
+ ':ROFF and TOFF v image:A:1,9,10:',/,1X,
+ ':Resid and wresid v image:A:1,11,12:',/,1X,
+ ':I/sig(I) overall and outer v image:N:1,18,19:',/,1X,
+ ':Rsym v image:N:1,20: ',/,1X,
+ ':SDratio v image:N:1,22: $$',/,1X,
+ 'IMAGE CCX CCY CCOM DIST YSCALE TILT TWIST ROFF',
+ ' TOFF RESID WRESID F P O N B I/sig(I)',
+ ' I/sig(I)_outer Rsym Nsym SDRAT $$ $$')
CAL + 'IMAGE CCX CCY CCOM DIST YSCALE TILT TWIST ROFF',
CAL + ' TOFF RESID WRESID FULL PART OVRL NEG BAD I/sig(I)',
CAL + ' I/sig(I)_overall Rsym Nsym SDRAT $$ $$')
DO 10 I = NSUMSTART1,NLSUM1
WRITE(ISUMMR,FMT=6002) LINESUM1(I)
10 CONTINUE
6002 FORMAT(A)
WRITE(ISUMMR,FMT=6004)
6004 FORMAT(1X,'$$')
C
C---- Now post-refinement results
C
WRITE (ISUMMR,FMT=6010)
6010 FORMAT(1X,1X,'$TABLE: Post refinement:'
+ ,/,1X,'$GRAPHS ',
+ ':Missets phix phiy phiz v image:A:1,2,3,4: ',/,1X,
+ ':Cell parameters A,B,C v image:A:1,5,6,7: ',/,1X,
+ ':Cell angles alpha beta gamma v image:A:1,8,9,10: ',/,1X,
+ ':Mosaic spread v image:A:1,11: ',/,1X,
+ ':Beam divergences v image:A:1,12,13: $$ ',/,1X,
+ 'Image PHIX PHIY PHIZ A B C',
+ ' ALPHA BETA GAMMA MOSAIC DIVH DIVV Resid NR',
+ ' $$ $$')
DO 12 I = NSUMSTART2,NLSUM2
WRITE(ISUMMR,FMT=6002) LINESUM2(I)
12 CONTINUE
WRITE(ISUMMR,FMT=6004)
C
C---- Reset start point for printing so that each "RUN" is only written
C to summary file once.
NSUMSTART1 = NLSUM1 + 1
NSUMSTART2 = NLSUM2 + 1
END
C== GRSCALE ==
C
C
C
C
C
SUBROUTINE GRSCALE
C ==================
C
C
C---- Calculate graphics scale factor to allow up to "display" mm
C on either side of the centre of film to be displayed
C grfact converts from 10micron units to graphics pixels
C
C
C
C
C .. Local Scalars ..
REAL DISP10MU
INTEGER NHALF
C ..
C .. Intrinsic Functions ..
INTRINSIC MIN,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C
C
SAVE
C ..
C
C
DISP10MU = DISPLAY*100
C
C---- Subtract 1 from nhx,nhy to avoid rounding errors giving a
C pixel outside the display area (remember also that addressable
C points are 0:ngx-1, 0:ngy-1)
C
NHALF = MIN(NHX-1,NHY-1)
GRFACT = REAL(NHALF)/DISP10MU
C
C
END
SUBROUTINE HEADERMTZ(GTITLE,MTZNAM,SPGNAM,PGNAME,NSYM,NSYMP,RSYM)
C ====================
IMPLICIT NONE
C
C ..
C
C---- Sets up header block on output MTZ for STRATEGY option
C
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NSYM,NSYMP
CHARACTER GTITLE*80,MTZNAM*80,PGNAME*10,SPGNAM*10
C ..
C .. ARRAY Arguments ..
REAL RSYM(4,4,96)
C
C .. Local Scalars ..
INTEGER J,IPRINT
CHARACTER LATTYP*1
C ..
C .. Local Arrays ..
CHARACTER LABOUT(MCOLSTR)*30,CTYPEO(MCOLSTR)*1
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL LWOPEN,LWTITL,LWCELL,LWCLAB
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
c-harvest
C&&*&& include ../inc/mharvest.f
INTEGER MAXMTZ
PARAMETER (MAXMTZ = 16)
C .. Scalars in common block /CHARVEST/ ..
CHARACTER HVERSION*80,ProjectName*20,DataSetName*20,
+ HBEAMLINE*10,Precipitant*80,
+ PNAME_COLS(MAXMTZ)*20,
+ DNAME_COLS(MAXMTZ)*20
C .. Scalars in common block /IHARVEST/ ..
LOGICAL USECWD,PNAMEgiven,DNAMEgiven,DOHARVEST
REAL PHhar,Hartemp,
+ HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
CHARACTER*3 MKDIRMODE,CHMODMODE
INTEGER KHFLMS
C ..
C .. Common block /CHARVEST/ ..
COMMON /CHARVEST/HVERSION,ProjectName,DataSetName,
+ HBEAMLINE,Precipitant,
+ PNAME_COLS,DNAME_COLS
C .. Common block /IHARVEST/ ..
COMMON /IHARVEST/USECWD,PHhar,Hartemp,KHFLMS,
+ PNAMEgiven,DNAMEgiven,DOHARVEST,
+ HARETA,HARDIV,HARDIH,MKDIRMODE,CHMODMODE
C ..
C&&*&& end_include ../inc/mharvest.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
c-harvest
SAVE
C ..
C .. Data statements ..
DATA (LABOUT(J),J=1,MCOLSTR)/'H','K','L','BATCH','PHI','IC'/
DATA (CTYPEO(J),J=1,MCOLSTR)/'H','H','H','B','R','I'/
C ..
C
MTZOUT = 1
C
C ***********************************************
CALL LWOPEN(MTZOUT,MTZNAM(1:LENSTR(MTZNAM)))
CALL LWTITL(MTZOUT,GTITLE,0)
CALL LWCELL(MTZOUT,CELL)
c-harvest
c-old CALL LWCLAB(MTZOUT,LABOUT,MCOLSTR,CTYPEO,0)
C
C---- Store the project name and dataset name in the mtz header:
C Subroutine to add dataset information to the output MTZ file header.
C Datasets identified by the PROTEIN_NAME/DATASET_NAME pair are
C appended to the MTZ header one at a time.
C Checks to see if the PROTEIN_NAME/DATASET_NAME pair is already
C included; if so, the dataset is not appended.
C Redundant datasets are removed in LWCLOS.
C
chrp18102000 CALL LWID(MTZOUT,PROJECTNAME,DATASETNAME)
CALL LWIDC(MTZOUT,PROJECTNAME,DATASETNAME,CELL,WAVE)
CALL LWCLAB(MTZOUT,LABOUT,MCOLSTR,CTYPEO,0)
C
C---- Subroutine to associate dataset entry with each column for
C the output MTZ file.
C
CALL LWIDAS(MTZOUT,MCOLSTR,PNAME_COLS,DNAME_COLS,0)
c-harvest
c
LATTYP = SPGNAM(1:1)
CALL LWSYMM(MTZOUT,NSYM,NSYMP,RSYM,LATTYP,NUMSPG,SPGNAM,
+ PGNAME)
C
C---- Need EPSILON for unique option
C
IPRINT = 0
CALL EPSLN(NSYM,NSYMP,RSYM,IPRINT)
CALL CENTRIC(NSYM,RSYM,IPRINT)
C ***********************************************
C
END
C== HKLLIM ==
C
SUBROUTINE HKLLIM(HMIN,HMAX,KMIN,KMAX,LMIN,LMAX)
C ===============================================================
C
C
C 22/3/93 Changed to match Laue groups from ASUSET, but code left
c here for some other numbers which are not used by ASUSET,
c viz 1,2,5,16 Phil Evans
C
C
C .. Scalar Arguments ..
INTEGER HMAX,HMIN,KMAX,KMIN,LMAX,LMIN
C ..
C ..
C .. Intrinsic Functions ..
INTRINSIC INT
C ..
C .. Common blocks ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C ..
C .. Save statement ..
SAVE
C ..
C
C
IF (NLAUE.LT.1 .OR. NLAUE.GT.16) GO TO 10
C
C---- otherwise set them from resolution command
C
C Note this IS CORRECT !
DMAX = WAVE/DSTMAX
IF (DEBUG(54)) THEN
WRITE(IOUT,FMT=6000) DMAX,WAVE,DSTMAX
IF (ONLINE) WRITE(ITOUT,FMT=6000) DMAX,WAVE,DSTMAX
6000 FORMAT(1X,'DMAX=',F6.3,' WAVE=',F8.5,' DSTMAX=',F8.6)
END IF
C
HMAX = INT(CELL(1)/DMAX)
KMAX = INT(CELL(2)/DMAX)
LMAX = INT(CELL(3)/DMAX)
C
HMIN = 0
KMIN = 0
LMIN = 0
C
C
IF (NLAUE.EQ.1) THEN
C
C---- LAUE = 1, 1bar, hkl:h>=0 0kl:k>=0 00l:l>=0
C*C Not used by ASUSET
C
KMIN = -KMAX
LMIN = -LMAX
RETURN
C
C---- LAUE = 2, 1bar, hkl:k>=0 h0l:l>=0 h00:h>=0
C*C Not used by ASUSET
C
ELSE IF (NLAUE.EQ.2) THEN
HMIN = -HMAX
LMIN = -LMAX
RETURN
C
C---- LAUE = 3, 1bar, hkl:l>=0 hk0:h>=0 0k0:k>=0
C
ELSE IF (NLAUE.EQ.3) THEN
HMIN = -HMAX
KMIN = -KMAX
RETURN
C
C---- LAUE = 4, 2/m, hkl:k>=0, l>=0 hk0:h>=0
C
ELSE IF (NLAUE.EQ.4) THEN
HMIN = -HMAX
RETURN
C
C---- LAUE = 5, 2/m, hkl:h>=0, l>=0 0kl:k>=0 (2-nd sett.)
C*C Not used by ASUSET
C
ELSE IF (NLAUE.EQ.5) THEN
KMIN = -KMAX
RETURN
C
C---- LAUE = 6, mmm, hkl:h>=0, k>=0, l>=0
C
ELSE IF (NLAUE.EQ.6) THEN
RETURN
C
C---- LAUE = 7, 4/m, hkl:h>=0, k>0, l>=0 with k>=0 for h=0
C
ELSE IF (NLAUE.EQ.7) THEN
RETURN
C
C---- LAUE = 8, 4/mmm, hkl:h>=0, h>=k>=0, l>=0
C
ELSE IF (NLAUE.EQ.8) THEN
RETURN
C
C---- LAUE = 9, 3bar, hkl:h>=0, k>0 including 00l:l>0
C
ELSE IF (NLAUE.EQ.9) THEN
KMAX = HMAX
LMIN = -LMAX
C*** This is wrong !
CAL KMIN = 1
RETURN
C
C---- LAUE = 10, 312, hkl:h>=0, k>=0 with k<=h and l>=0 if h = 0
C
ELSE IF (NLAUE.EQ.10) THEN
KMAX = HMAX
LMIN = -LMAX
RETURN
C
C---- LAUE = 11, 321, hkl:h>=0, k>=0 with k<=h and l>=0 if h = k
C
ELSE IF (NLAUE.EQ.11) THEN
KMAX = HMAX
LMIN = -LMAX
RETURN
C
C---- LAUE = 12, 6/m, hkl:h>=0, k>0, l>=0 with k>=0 for h=0
C
ELSE IF (NLAUE.EQ.12) THEN
KMAX = HMAX
RETURN
C
C---- LAUE = 13, 6/mmm, hkl:h>=0, h>=k>=0, l>=0
C
ELSE IF (NLAUE.EQ.13) THEN
KMAX = HMAX
RETURN
C
C---- LAUE = 14, m3, hkl:h>=0, k>=0, l>=0 with l>=h, k>=h for l=h
C and k>h for l>h
C
ELSE IF (NLAUE.EQ.14) THEN
RETURN
C
C---- LAUE = 15, m3m, hkl:k>=l>=h>=0
C
ELSE IF (NLAUE.EQ.15) THEN
RETURN
C
C---- LAUE = 16, m3m, hkl:h>=k>=l>=0
C*C Not used by ASUSET
C
ELSE IF (NLAUE.EQ.16) THEN
RETURN
END IF
C
C
10 WRITE (IOUT,FMT=6010) NLAUE
IF (ONLINE) WRITE (ITOUT,FMT=6010) NLAUE
6010 FORMAT (//1X,'**** WRONG LAUE GROUP = ',I6,' ****',/)
STOP
C
END
C
C
C
C== IBYTE ==
INTEGER FUNCTION IBYTE(IJBA,N)
C ==============================
C
C
C---- Un pack bytes
C
C
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Array Arguments ..
INTEGER*2 IJBA(*)
C ..
C .. Local Scalars ..
INTEGER I,JUNK,KJBA,M,MASKA,MASKB
C ..
C .. Intrinsic Functions ..
INTRINSIC MOD,IAND,ISHFT
C ..
C
DATA MASKA,MASKB/'377'O,'177400'O/
cc?? data maska,maskb/255,65280/
C
C
M = MOD(N,2)
I = (N-1)/2 + 1
KJBA = IJBA(I)
C
C
IF (M.EQ.0) THEN
C
C---- Even byte
C
JUNK = IAND(KJBA,MASKB)
IBYTE = ISHFT(JUNK,-8)
ELSE
C
C---- Odd byte
C
IBYTE = IAND(KJBA,MASKA)
END IF
C
C
END
C== ICMP ==
INTEGER FUNCTION ICMP(IARR1,I1,IARR2,I2,NKEY)
C =============================================
C
C
C
implicit none
C
C
C
C---- This function is used to compare the values of the sort keys
C for 2 reflections
C
C
C---- Parameters
C
C IARR1 (I) ARRAY CONTAINING 1ST SET OF KEYS (INTEGER)
C I1 (I) POINTER TO FIRST KEY IN IARR1
C IARR2 (I) ARRAY CONTAINING 2ND SET OF KEYS (INTEGER)
C I2 (I) POINTER TO FIRST KEY IN IARR2
C NKEY (I) NO. OF KEYS
C
C FUNCTION RETURN VALUES -1 REFLN 1 LT REFLN 2
C 0 REFLN 1 EQ REFLN 2
C 1 REFLN 1 GT REFLN 2
C
C---- Specification statements
C
C
C---- Compare keys
C
C .. Scalar Arguments ..
INTEGER I1,I2,NKEY
C ..
C .. Array Arguments ..
INTEGER*2 IARR1(*),IARR2(*)
C ..
C .. Local Scalars ..
INTEGER I,J1,J2
C ..
C
C
J1 = (I1-1)*NKEY
J2 = (I2-1)*NKEY
C
C
DO 10 I = 1,NKEY
J1 = J1 + 1
J2 = J2 + 1
IF (IARR1(J1)-IARR2(J2)) 30,10,20
10 CONTINUE
C
C
ICMP = 0
RETURN
C
20 ICMP = 1
RETURN
C
30 ICMP = -1
C
C
END
C
C
C
SUBROUTINE IDNMAT(A)
C ====================
C
C Set matrix A(3,3) to identity
C
REAL A(3,3)
C
CALL CLEAR(A)
A(1,1)=1.0
A(2,2)=1.0
A(3,3)=1.0
RETURN
END
C== IDXREF ==
C
SUBROUTINE IDXREF(NADDL,FIXED,NIMAG,NPOINT,NOREFCELL,NEWPREF,
$ ISTAT)
C ===========================================================
C
IMPLICIT NONE
C---- Set up for post-refinement of missetting angles and cell parameters
C DEBUG(39) this S/R
C
C NADDL.... For old-style post refinement:
C Number of images to be added together for use in
C post-refinement. Note than when NADD>1 but NIMAG1 but NIMAG32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C ..
C .. Scalar Arguments ..
CHARACTER*(*) IMGNUM
INTEGER NTDIG,ID
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,J,K,NCH,IFLAG
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
IFLAG = 0
IF (NTDIG.EQ.1) THEN
IF (ID.GT.9) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6000) ID
ELSE IF (NTDIG.EQ.2) THEN
IF (ID.GT.99) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6002) ID
ELSE IF (NTDIG.EQ.3) THEN
IF (ID.GT.999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6004) ID
ELSE IF (NTDIG.EQ.4) THEN
IF (ID.GT.9999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6006) ID
ELSE IF (NTDIG.EQ.5) THEN
IF (ID.GT.99999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6008) ID
ELSE IF (NTDIG.EQ.6) THEN
IF (ID.GT.999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6010) ID
ELSE IF (NTDIG.EQ.7) THEN
IF (ID.GT.9999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6012) ID
ELSE IF (NTDIG.EQ.8) THEN
IF (ID.GT.99999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6014) ID
ELSE IF (NTDIG.EQ.9) THEN
IF (ID.GT.999999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(IMGNUM,6016) ID
END IF
RETURN
6000 FORMAT(I1.1)
6002 FORMAT(I2.2)
6004 FORMAT(I3.3)
6006 FORMAT(I4.4)
6008 FORMAT(I5.5)
6010 FORMAT(I6.6)
6012 FORMAT(I7.7)
6014 FORMAT(I8.8)
6016 FORMAT(I9.9)
END
SUBROUTINE IMGOUT(ID,ODFILE)
C =========================
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
CHARACTER ODFILE*200
INTEGER ID
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,IODOUT,IDOT,NCH,NPIX,IFAIL,IYLEN2,NCMITM,NOVRL,IOD
C ..
C .. Local Arrays ..
INTEGER IHEAD(IYLENGTH)
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
CALL IMSIZ(ODFILE,NREC,IYLEN)
C
C---- Open output filename
C
NCH = LENSTR(ODFILE)
DO 10 I = NCH,1,-1
IF (ODFILE(I:I).EQ.'.') THEN
IDOT = I
GOTO 20
END IF
10 CONTINUE
C
C---- No dot found
C
WRITE(IOUT,FMT=1000)
IF (ONLINE) WRITE(ITOUT,FMT=1000)
1000 FORMAT(1X,'Filename does not contain an extension (eg .pck)')
STOP
C
20 ODFILE = ODFILE(1:IDOT)//'image'
IODOUT = 20
IFAIL = 0
CALL QOPEN(IODOUT,ODFILE,'UNKNOWN')
WRITE (IOUT,FMT=1010) ID,ODFILE(1:LENSTR(ODFILE))
IF (ONLINE) WRITE (ITOUT,FMT=1010) ID,ODFILE(1:LENSTR(ODFILE))
1010 FORMAT(1X,'Writing unpacked image',I4,' to file: ',A)
IHEAD(1) = NREC
IHEAD(2) = IYLEN
IYLEN2 = IYLEN/2
NPIX = NREC*IYLEN
C
C---- Must convert values greater than 32767 back to 2's complement
C
NOVRL = 0
DO 30 I = 1,NPIX
IF (IMAGE(I).LT.0) THEN
IOD = -8*IMAGE(I)
IF (IOD.GT.65535) THEN
NOVRL = NOVRL + 1
IOD = -1
ELSE
IOD = IOD - 65536
END IF
IMAGE(I) = IOD
END IF
30 CONTINUE
IF (NOVRL.GT.0) THEN
WRITE(IOUT,FMT=1020) NOVRL
IF (ONLINE) WRITE(ITOUT,FMT=1020) NOVRL
1020 FORMAT(/,1X,'***** WARNING *****',/,1X,'***** WARNING *****',
+ /,1X,'Number of pixels with values greater than 65535:',
+ I7,/,1X,'These pixels have been assigned a value 65536 in',
+ ' the output file.')
END IF
CALL QMODE(IODOUT,2,NCMITM)
CALL QWRITI(IODOUT,IHEAD,IYLEN2)
CALL QMODE(IODOUT,1,NCMITM)
CALL QWRITI(IODOUT,IMAGE,NPIX)
C WRITE(IODOUT)(IHEAD(I),I=1,IYLEN2),(IMAGE(I),I=1,NPIX)
C CLOSE(UNIT=IODOUT)
CALL QCLOSE(IODOUT)
RETURN
END
c
C
C
SUBROUTINE INIKBB
C =================
C
c initialize keyboard buffer
C
IMPLICIT NONE
C
C&&*&& include ../inc/mxdkbb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdkbb.h
C---- START of include file mxdkbb.h
C
c
c********** mxdkbb *************
c
c Keyboard input buffer
c
c kbdbuf(0:maxkbb-1) rotating line buffer
c ip1kbb read pointer (= -1 is no lines to read)
c ip2kbb write pointer
c markbb mark point (= -1 if unset)
c
integer maxkbb
parameter (maxkbb = 10)
character*80 kbdbuf(0:maxkbb-1)
integer ip1kbb, ip2kbb, markbb
c
common /kbblin/ kbdbuf
common /kbbptr/ ip1kbb, ip2kbb, markbb
c
save /kbblin/, /kbbptr/
c
C&&*&& end_include ../inc/mxdkbb.f
C
IP1KBB = -1
IP2KBB = 0
MARKBB = -1
RETURN
END
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE INITIALIZE(INIT_MODE,GENOPEN,NEWGENFL)
IMPLICIT NONE
C
C---- subroutine to intialize and re-initialize variables in Mosflm.
C Original code taken from the top end of mosflm.f (20th November
C 2001)
C
C---- everything except INIT_MODE here is in common blocks in include
C files.
C
C---- EXTERNAL FUNCTIONS
LOGICAL CCPONL
EXTERNAL CCPONL
C
C---- EXTERNAL SUBROUTINES
EXTERNAL CCPOPN
C
C---- INTEGER ARGUMENT
C
C INIT_MODE is used to determine what to initialize
C INIT_MODE = 0, initialize everything
C = 1, er?
C
INTEGER INIT_MODE
LOGICAL GENOPEN,NEWGENFL
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/mxdspl.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C---- START of include file mxdspl.h
C
C
C---- PARAMETERS first
C
INTEGER NPARM
PARAMETER (NPARM = 200)
INTEGER MAXSEG
PARAMETER (MAXSEG = 20)
INTEGER NCIRC
PARAMETER (NCIRC=4)
C Circle points
INTEGER MAXCPT
PARAMETER (MAXCPT = 200)
C
INTEGER LCLEAN, IEXTYZ, LCORRC
C
C JIMGN(1) first image number
C JIMGN(2) number of images
INTEGER JIMGN
C
C MENU ITEM NUMBERS
INTEGER MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,MBADSP,
+ MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,MMEAS,
+ MCIRC,MREAD,MFIND,MEDIT,MMOSA,MCLRSPT,MSEL,MAUTO,MPRED,
+ MCLRPRD,MPREF,MINTEG,MSTRAT,MKEYWD,MADJ2,MFHKL,MCIRCF
C Possible ones to be added ?
INTEGER ISCL
C
C Active object list
C ivhlist(1) menu
C ivhlist(2) parameters
C ivhlist(3) image
INTEGER NUMVH, IVHLIST,IVH, NUMVH2, IVHLIST2
c npx number of points in box
INTEGER NPX
INTEGER IVECB, IVECC
C .. local scalars ..
INTEGER I,J,IQUIT,ISTAT,IERR,MEASUR,ITEM,IX,IY,L,M,JY,JZ,NSOL,
$ NADDS,MODEG,NFULLF
INTEGER IX1,IY1,IX2,IY2,JY2,JZ2, IZOOM, MEASPT, NORDER,
+ IXM, IYM, IXP, IYP, KFLAG, IBUTTON,IFLAG, IISIZE,
+ NDISPP,IRECG,IJUNK,IFAIL,NCH,NCH2,MODEOP,ID,NFIRSTI,MODESP,
+ MODECTRL,IPACKF,IPACKL,NSERLOC,LINELEN,NUMLIN,IPAUSE,
+ ICOUNT,JSEG,IM1,JIMAG,K,ICHECK,NTOT,ICOLR,JFIRST,ITOG,
+ IPACK,NPROC,IXCEN,IYCEN,IRMIN,IRMAX,MODEGSR,ISTRTSV,
+ IANGLESV,IFLAGPR,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ MODEDISP,NUMSAVE,NPROFL,NUMBLOCK,IERR2
C Circle points
INTEGER NCIRPT, MCIRPT, IXYCPT, MAXDPT
INTEGER INCIMG,MSECS
INTEGER IADJP,NDISP
C JDSPAU auto display flag, .gt. 0 for image display in
C Find & Collect: display every JDPSAUth image
INTEGER JDSPAU
C .. Local arrays ..
INTEGER IXADJ,IYADJ,IHKL,IHKLX,IMS1,
+ IMF1
C
C things for parser
C
INTEGER IBEG,IDEC,IEND,ITYP
INTEGER NTOK
C
C---- Real variables
C
C Menu
REAL RESCMX
REAL RESCIR
c
c pxavg average of box
c pxrms rms of box
REAL PXAVG, PXRMS
C
C .. Local Scalars ..
REAL PHIBEGS,XSEP,YSEP,OMEGAFD,RX,RY,TOTPHI,PRWIDTH,THETA,
+ OHDIST,X,MAXCELL
c
c Circle points
REAL CIRCEN, CIRRAD
C
C---- Following needed for call to CONTROL
C
REAL DUMMY, RESOL, SPACNG, XMEASPT,RJY,RJZ,DTOR,RAD,
+ PHISTART
C ..
C .. Local Arrays ..
REAL PSI,PHIPRF,OSCPRF
C
C---- Things for parser
C
REAL VALUE
C
C---- now for character variables
C
C Menu
CHARACTER*(MAX_MEN_NAME) MENU_ITEMS,
+ MENU_ITEMS2
C
CHARACTER*(MAX_MEN_NAME) EXIT_NAME
C ..
C .. Local Scalars ..
CHARACTER PROMPT*80, LINE*80, STR*100 ,TEMPCH*100,
+ STR1*1,STR2*4,STR3*4,STR4*7,LINE2*80,SUBKEY*4,KEY*4,
+ BIGLINE*120,STR5*9,VALUESTR*80,WAXFNN*134,MTZNAMP*80
CHARACTER STORIMAG*200
C
C---- Following needed for call to CONTROL
C
CHARACTER CELLSTR*50
C
CHARACTER FNAME
C .. Local Arrays ..
CHARACTER MATFILN*70,IDENTPRF*80
C
C---- finally, LOGICALS
C
LOGICAL CALC_VB1,CALC_VB2
C
C---- local scalars
C
LOGICAL PREDICTED,SNEWGENF,EFILE,GIVEMAT,BOXOPEN,LPRNT,
+ UPDATE,NEWRAST,NEWSEP,FORCEREAD,GENFILESET,BADTOG,
+ NEWCELL,NPSI,BOXOPEN2,RFRESH,SAVED,RFIXCELL,RFIXDIST,
+ NULINE,NEWWIN,AUTOIND,CHRMIN,CHRMAX,ADDSPOTS,AUTOINDS,
+ DEFPHI,GWRITE,DOPROFILE,FAIL,LIST,SNOCENT,SNOREFINE,
$ SRMOSAIC,SFIRSTFILM,SGENOPEN,SFIRSTTIME,smultiseg,
$ JUMPBACK,ADDPP
C Circle points
LOGICAL LFITCIRC
C needed for call to control
LOGICAL FIRSTTIME,NEWGENF,RPTFIRST
LOGICAL LPICK,LPLRNG,PICKED,CIRCLES,NEWRES,NEWSCL,LAUTOM,LPRKBC,
+ LIN1,ADJUST,LINDEX,LSPOT,LSPEDIT,LKILL,NTHRESH,NSCAL,MENU2,
+ ROTATED,NEWSPOTS,LBADSP,LDISPSPT
LOGICAL DPS_INDEX,DPS_SEARCH
C .. local arrays ..
LOGICAL INMAT
COMMON /GUIVAR/LCLEAN(3),IEXTYZ(2),LCORRC,
$ JIMGN(2),MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,
+ MBADSP,MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,
+ MMEAS,MCIRC,MREAD,MFIND,MEDIT,MMOSA,MCLRSPT,MSEL,MAUTO,
+ MPRED,MCLRPRD,MPREF,MINTEG,MSTRAT,MKEYWD,MADJ2,MFHKL,
$ MCIRCF,ISCL,NUMVH,IVHLIST(3),IVH,NUMVH2,IVHLIST2(3),NPX,
$ IVECB,IVECC,I,J,IQUIT,ISTAT,IERR,MEASUR,ITEM,IX,IY,L,M,JY,
$ JZ,NSOL,NADDS,MODEG,NFULLF,
$ IX1,IY1,IX2,IY2,JY2,JZ2, IZOOM, MEASPT(2,2), NORDER,
+ IXM, IYM, IXP, IYP, KFLAG, IBUTTON,IFLAG, IISIZE,
+ NDISPP,IRECG,IJUNK,IFAIL,NCH,NCH2,MODEOP,ID,NFIRSTI,
+ MODESP,MODECTRL,IPACKF,IPACKL,NSERLOC,LINELEN,NUMLIN,
+ IPAUSE,ICOUNT,JSEG,IM1,JIMAG,K,ICHECK,NTOT,ICOLR,JFIRST,
+ ITOG,IPACK,NPROC,IXCEN,IYCEN,IRMIN,IRMAX,MODEGSR,ISTRTSV,
+ IANGLESV,IFLAGPR,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ MODEDISP,NUMSAVE,NPROFL,NUMBLOCK,IERR2,NCIRPT,
$ MCIRPT,IXYCPT(2,MAXCPT), MAXDPT,INCIMG,MSECS,IADJP,NDISP,
$ JDSPAU,IXADJ(4),IYADJ(4),IHKL(5),IHKLX(5),IMS1(MAXSEG),
+ IMF1(MAXSEG),IBEG(NPARM),IDEC(NPARM),IEND(NPARM),
$ ITYP(NPARM),NTOK,
$ RESCMX,RESCIR(NCIRC),PXAVG, PXRMS,PHIBEGS,XSEP,YSEP,
$ OMEGAFD,RX,RY,TOTPHI,PRWIDTH,THETA,OHDIST,X,MAXCELL,
$ CIRCEN(2), CIRRAD,DUMMY, RESOL, SPACNG, XMEASPT(2,2),RJY,
$ RJZ,DTOR,RAD,PHISTART,PSI(3),PHIPRF(MAXSEG),
$ OSCPRF(MAXSEG),VALUE(NPARM)
COMMON /GUICHA/ MENU_ITEMS(MAX_MEN_ITMS),
+ MENU_ITEMS2(MAX_MEN_ITMS),
$ EXIT_NAME,
$ PROMPT, LINE, STR ,TEMPCH,
+ STR1,STR2,STR3,STR4,LINE2,SUBKEY,KEY,
+ BIGLINE,STR5,VALUESTR,WAXFNN,MTZNAMP,
$ STORIMAG,CELLSTR,FNAME,MATFILN(MAXSEG),
$ IDENTPRF(MAXSEG)
COMMON /GUILOG/CALC_VB1,CALC_VB2,
$ PREDICTED,SNEWGENF,EFILE,GIVEMAT,BOXOPEN,LPRNT,
+ UPDATE,NEWRAST,NEWSEP,FORCEREAD,GENFILESET,BADTOG,
+ NEWCELL,NPSI,BOXOPEN2,RFRESH,SAVED,RFIXCELL,RFIXDIST,
+ NULINE,NEWWIN,AUTOIND,CHRMIN,CHRMAX,ADDSPOTS,AUTOINDS,
+ DEFPHI,GWRITE,DOPROFILE,FAIL,LIST,SNOCENT,SNOREFINE,
$ SRMOSAIC,SFIRSTFILM,SGENOPEN,SFIRSTTIME,smultiseg,
$ JUMPBACK,ADDPP,LFITCIRC, FIRSTTIME,NEWGENF,RPTFIRST,
$ LPICK,LPLRNG,PICKED,CIRCLES,NEWRES,NEWSCL,LAUTOM,LPRKBC,
+ LIN1,ADJUST,LINDEX,LSPOT,LSPEDIT,LKILL,NTHRESH,NSCAL,
+ MENU2,ROTATED,NEWSPOTS,LBADSP,LDISPSPT,DPS_INDEX,
$ DPS_SEARCH,INMAT(MAXSEG)
C&&*&& end_include ../inc/mxdspl.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/tiltlog.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- awk generated include file tiltlog.h
C---- START of include file tiltlog.h
C
C for things connected with the new definitions of TILT and TWIST
C
C .. Scalars in common block /TILTLOG/ ..
LOGICAL NUTWIST
COMMON /TILTLOG/NUTWIST
C&&*&& end_include ../inc/tiltlog.f
C
C---- local scalars
C
INTEGER LDUM
CHARACTER VERNO*100,MOSLPFILE*60,FULLFN*100
SAVE
C
C---- start here. initialize everything
C
IF(INIT_MODE.EQ.0)THEN
JPGOUT = .FALSE.
MOSEST = .FALSE.
MOSES2 = .TRUE.
CHRP MOSDONE = .FALSE.
NUTWIST = .FALSE.
NUREEK = .FALSE.
GENOPEN = .FALSE.
LOGETA = .FALSE.
NEWGENF = .TRUE.
NEWGENFL = NEWGENF
C
C---- Fix for Dec Alphas to get CCPONL to return correct value
C
WRITE(6,'(/)')
C
ONLINE = .FALSE.
ONLINE = (CCPONL())
C
C---- input stream for parser (changed to icomm=4 if reading
C commands from a file)
C
ITIN = 5
ITOUT = 6
IOUT = 8
IFAIL = 1
LDUM = 80
C
C ***********************************
CALL CCPOPN(-ITIN,'DATA',5,1,LDUM,IFAIL)
C ***********************************
C
C
IF (.NOT.ONLINE) THEN
IOUT = 6
ITOUT = 8
C
C *************************************
CALL CCPOPN(-IOUT,'PRINTER',1,1,LDUM,IFAIL)
C *************************************
C
ELSE
C
C ***************************************
c hrp23022001 CALL CCPOPN(-IOUT,'mosflm.lp',1,1,LDUM,IFAIL)
C ***************************************
C multiple mosflm.lp files....
C
C---- First see if environment variable is set
C
CALL UGTENV('MOSFLM_VERSION_NUMBERS',VERNO)
IF (VERNO(1:4).EQ.'TRUE') THEN
C
C---- Test if any version of file exists
C
DO 1066 I = 1,99
WRITE(STR2,FMT=6000) I
6000 FORMAT(I2.2)
MOSLPFILE = 'mosflm_'//STR2//'.lp'
INQUIRE (FILE=MOSLPFILE,EXIST=EFILE,NAME=FULLFN)
IF (.NOT.EFILE) GOTO 1067
1066 CONTINUE
C
C---- 01 to 99 all exist, start again at 01
C
I = 1
WRITE(STR2,FMT=6000) I
MOSLPFILE = 'mosflm_'//STR2//'.lp'
C
ELSE
MOSLPFILE = "mosflm.lp"
ENDIF
C ***************************************
1067 CALL CCPOPN(-IOUT,MOSLPFILE,1,1,LDUM,IFAIL)
C ***************************************
C
C
END IF
C
C---- MOSFLM.OUT file
C
INMO = 3
C
C---- HKL for reflections to be dumped
C
IDU = 9
C
C---- Summary file
C
ISUMMR = 7
C
C---- Spot coordinate file (for DENSE images)
C
ICOORD = 10
C
C---- Test detector type for this version of code
C
CALL DET(IMGP)
c -harvest
C
C IF(HARVESTREADY)CALL MHARVEST(0)
CALL MHARVEST(0)
c -harvest
C
C---- Program version
C
CALL VERSION(IMGP)
C
C
IFAIL = 1
C *************************************
CALL CCPOPN(-ISUMMR,'SUMMARY',1,1,80,IFAIL)
C *************************************
ICURR = 0
C
MODECTRL = 0
C
C
C---- end of INIT_MODE = 0 code
C
ENDIF
RETURN
END
C== INTEG ==
SUBROUTINE INTEG(OD,IRAS,MASK,PQVAL,IDR,FULL,BGKSIG,MASKREJ,
+ PQSUMS,NRBX)
C =============================================
IMPLICIT NONE
C
C---- Evaluate the integrated intensity, centre of gravity, background
C plane constants and rms variation in background of a spot
C with the measurement box stored in OD.
C
C Elements of PQVAL
C p,q are pixel coords wrt centre of box
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C Elements of PQSUMS
C This array is set up int this subroutine, and then updated fro rejected
C background pixels in BGTEST.
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY. Note that these sums are updated for every spot based
C on rejected background pixels (done in BGTEST)
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C
C Modified to deal with background point rejection 14/3/91
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL BGKSIG
INTEGER IDR,NRBX
LOGICAL FULL
C ..
C .. Array Arguments ..
REAL PQVAL(6),PQSUMS(6)
INTEGER IRAS(5),MASK(MAXBOX),OD(MAXBOX),MASKREJ(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,B,C,SP,SQ,SPQ,
+ SOD,SPOD,SQOD,TOD,TPOD,TQOD
INTEGER HX,HY,IJ,IOD,P,Q,NXY,NBKG,NRLMAX,NDBG,NXX,NYY,MODE
C ..
C .. Local Arrays ..
C ..
C ..
C .. External Subroutines ..
EXTERNAL EVAL
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C
C .. Equivalences ..
EQUIVALENCE (ASPOT(6),SPOD)
EQUIVALENCE (ASPOT(7),SQOD), (ASPOT(8),SOD), (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C)
C
SAVE
C ..
C
C
C---- Mode for EVAL (signifies we have not flagged overlapped background
C pixels)
MODE = 0
NXX = IRAS(1)
NYY = IRAS(2)
HX = NXX/2
HY = NYY/2
NXY = NXX*NYY
C
SP = 0.0
SQ = 0.0
SPQ = 0.0
SPOD = 0.0
SQOD = 0.0
SOD = 0.0
TOD = 0.0
TPOD = 0.0
TQOD = 0.0
IJ = 0
C
C
DO 40 P = -HX,HX
C
DO 30 Q = -HY,HY
IJ = IJ + 1
IOD = OD(IJ)
IF (MASK(IJ).EQ.0) THEN
GOTO 30
ELSE IF (MASK(IJ).GT.0) THEN
GOTO 20
END IF
C
C Background pixels
SP = P + SP
SQ = Q + SQ
SPQ = P*Q + SPQ
SPOD = P*IOD + SPOD
SQOD = Q*IOD + SQOD
SOD = SOD + IOD
GOTO 30
C
C Peak pixels
20 TPOD = P*IOD + TPOD
TQOD = Q*IOD + TQOD
TOD = TOD + IOD
30 CONTINUE
40 CONTINUE
C
C
C Background constants
A = SPOD/PQVAL(2)
B = SQOD/PQVAL(4)
C = SOD/PQVAL(6)
C
C Set up PQSUMS .
PQSUMS(1) = PQVAL(2)
PQSUMS(2) = PQVAL(4)
PQSUMS(3) = SPQ
PQSUMS(4) = SP
PQSUMS(5) = SQ
PQSUMS(6) = PQVAL(6)
NBKG = NINT(PQVAL(6))
C
C Set maximum allowed number of allowed background pixels to be
C rejected from background plane determination. NBGMIN is keyword set
C and passed through /BACKG/
C
NRLMAX = NBKG - NBGMIN
C
C---- Tets for too few background points
C
IF (NRLMAX.LT.0) THEN
ASPOT(1) = -9999.0
RETURN
END IF
C
C
C ***********************************************
CALL EVAL(OD(1),MASK(1),IRAS,PQSUMS,BGKSIG,NRLMAX,NRBX,
+ MASKREJ(1),DEBUG(43),MODE)
C ***********************************************
C
C
C---- Check that not too many background points have been rejected
C (Flagged by NRLMAX=-999)
C
IF (NRLMAX.EQ.-999) THEN
ASPOT(1) = -9999.0
RETURN
END IF
C
C Recalculate SPOT based on new value of C
C
C
ASPOT(2) = PQVAL(5)*C
ASPOT(1) = TOD - ASPOT(2)
C
C
C ASPOT(2) is used in calculation of counting statistics errors.
C Must subtract scanner adc offset here
C
ASPOT(2) = ASPOT(2) - PQVAL(5)*IDIVIDE
C
IF (FULL) THEN
C
C----- Catch zero spots
C
IF (ASPOT(1).NE.0.0) THEN
ASPOT(4) = (TPOD-PQVAL(1)*A)/ASPOT(1)*IDR
ASPOT(5) = (TQOD-PQVAL(3)*B)/ASPOT(1)
ELSE
ASPOT(4) = 0.0
ASPOT(5) = 0.0
END IF
END IF
C
IF (DEBUG(43).AND.(NDBG.LE.NDEBUG(43))) THEN
WRITE(IOUT,FMT=6000) ASPOT(1),ASPOT(2),
+ ASPOT(3),ASPOT(4),TOD,PQVAL
IF (ONLINE) WRITE(ITOUT,FMT=6000) ASPOT(1),ASPOT(2),
+ ASPOT(3),ASPOT(4),TOD,PQVAL
6000 FORMAT(1X,'From INTEG, ASPOT(1-4)',4F12.0,/,1X,'TOD',F12.0,
+ ' PQVAL',6F8.0)
NDBG = NDBG + 1
END IF
C
END
C
C== INTEG2 ==
SUBROUTINE INTEG2(OD,IPROFL,IRAS,MASK,MASKREJ,MASKREJP,LMASKREJP,
+ MASKREJO,PQVAL,PQSUMS,PQSUMINV,PROFSUMS,WPROFSUMS,IDR,
+ NBREJ,BGSIG,FULL,IPART,WEIGHT,OVRLFIT,CUTOFF,EDGEFIT,ISUMPART,
+ PKWDLIM1,PKWDLIM2,PKWDLIM3,XDEBUG,PKONLY,PKWDOUTL,IOUTL1,
+ IOUTL2,DECONV,BADSPOT)
C =============================================================
C
IMPLICIT NONE
C
C
C---- *** WARNING **** ASPOT(14) (PEAKVAR) may well not be correct
C if there are rejected peak pixels and WEIGHTED profile fitting
C is NOT being used.
C
C This subroutine is called from subroutine "process". MASK
C contains the peak/background mask definition (peak pixels
C have a value +1, background pixels -1)and rejected
C background pixels (due to overlapping neighbouring spots)
C have been flagged with value 0. (This has been done by
C subroutine MASKIT). MASKREJ contains a list of
C these rejected background pixels.
C
C---- Determine integrated intensities for all spots in final
C pass. Determines both the simple integrated intensity and
C the profile fitted intensity with optional weighting.
C Allows rejection of background points more than BGSIG*RMSBG
C from best background plane.
C If changemask is set, the background points may have been
C modified during formation of the standard profiles.
C thus the background area may no longer have mm symmetry if
C NBREJ, the number of points rejected, is non-zero,
C but **** the peak area is always assumed to have mm symmetry ***
C and this is implicit in the equations for the integrated intensity.
C
C OD Array containing pixel values
C
C IPROFL Array conating the profile to be used in evaluating
C profile fitted intensity for this reflection.
C
C IRAS Raster parameters (NX,NY,NC,NRX,NRY)
C
C MASK Array defining peak/background and rejected pixels.
C When using variable profiles this mask can be different
C for different spots in the same "standard profile area"
C and is set up in "process" using information from "getprof".
C This array is unchanged.
C
C MASKREJ Array containing list of rejected background pixels
C due to overlap of neighbouring spots.
C This is unchanged.
C
C MASKREJP Array containing list of rejected peak pixels
C due to overlap of neighbouring spots.
C This is unchanged.
C
C LMASKREJP Array containing list of rejected peak pixels
C due to very poor profile fit. This is set up in this
C subroutine and passed back to PROCESS and PLOTPROF
C
C MASKREJO Array containing list of rejected background pixels
C because they are outliers. This is set up in EVAL
C and passed back to PROCESS for use in PROFPLOT.
C
C ISUMPART = 0 normally
C = 1 for a summed partial (need to subtract 2*adcoffset)
C
C Elements of PROFSUMS
C 1 = sum p*P p,q are pixel coords wrt centre of box
C 2 = sum q*P P is the profile value
C 3 = sum P summations are over peak pixels only
C 4 = sum P*P
C
C Elements of WPROFSUMS
C 1 = sum p*P p,q are pixel coords wrt centre of box
C 2 = sum q*P P is the profile value
C 3 = sum P summations is over all pixels except rejected
C 4 = sum P*P background pixels.
C
C
C Elements of PQVAL
C p,q are pixel coords wrt centre of box
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C Elements of PQSUMS
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY. Note that these values are copied to a local array
C SPOTPQSUM because they are updated for every spot based
C on rejected background pixels (done in BGTEST)
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL BGSIG,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER IDR,NBREJ,CUTOFF,IPART,ISUMPART,IOUTL1,IOUTL2
LOGICAL FULL,WEIGHT,OVRLFIT,EDGEFIT,XDEBUG,PKONLY,DECONV,
+ BADSPOT
C ..
C .. Array Arguments ..
REAL PQSUMINV(3,3),PQSUMS(6),PQVAL(6),PROFSUMS(4),WPROFSUMS(4)
INTEGER IRAS(5),MASK(MAXBOX),OD(MAXBOX),IPROFL(MAXBOX),
+ MASKREJ(NREJMAX),MASKREJP(NREJMAX),MASKREJO(NREJMAX),
+ LMASKREJP(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,B,C,RMSBG,SBGOD,SBGPOD,SBGQOD,
+ SPKOD,SPKODSQ,SPKPOD,SPKQOD,SUMPROD,SWPR,SWPPR,SWPRSQ,
+ SWQPR,SWPSQ,SWPQ,SWP,SWQSQ,SWQ,SW,SWPOD,SWQOD,SWOD,SWPROD,
+ WT,WTPR,XJ,BGDEVMAX,WSCAL,PART,AS,BS,CS,XI,RHOC,RHOC1,PSCALE,
+ SWDELSQ,DEL,SDELSQ,WDELSQ,WDEL,APKWDOUTL
INTEGER HX,HY,IJ,IOD,K,P,Q,NRLMAX,NRFL,IPROFIJ,I,NXX,NYY,NDBG,
+ NREJ,NPIX,N,MODE,MULT,MAXPIX,NREJP,NBADP,IPASS,NBADSAVE,
+ NGENBAD,MODEP,IERR
LOGICAL PEAKREJ,BADPIX,OUTLIERS,SSIGN,INRANGE,ZEROD
C ..
C .. Local Arrays ..
REAL ABC(3),SPOTPQSUM(6),SPQOD(3),PROFSUML(4),PMAT(4,4),
+ PMATI(4,4),X(4),XR(4),WPROFSUML(4)
INTEGER LMASK(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN,PIXOVERLAP,ODPLOT4,
+ RASPLOT4,EVAL,MINV4,MATVEC4
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (SPQOD(1),SBGPOD), (SPQOD(2),SBGQOD), (SPQOD(3),SBGOD)
EQUIVALENCE (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(6),SBGPOD)
EQUIVALENCE (ASPOT(7),SBGQOD), (ASPOT(8),SBGOD), (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C), (ASPOT(12),BGDEVMAX)
C ..
SAVE
C
DATA NDBG/0/
C
IF (XDEBUG) DEBUG(34) = .TRUE.
BADSPOT = .FALSE.
MAXPIX = 0
IPASS = 0
NBADP = 0
NBADSAVE = 0
BADPIX = .FALSE.
OUTLIERS = .FALSE.
APKWDOUTL = ABS(PKWDOUTL)
C
C---- Number of rejected peak pixels
C
NREJP = MASKREJP(1)
PEAKREJ = (NREJP.GT.0)
C
C
C---- Mode for EVAL (signifies we now have flagged overlapped background
C pixels)
MODE = 1
NRFL = 1
NXX = IRAS(1)
NYY = IRAS(2)
HX = NXX/2
HY = NYY/2
C
C---- Debug o/p
C
IF (XDEBUG) CALL RASPLOT4(OD,NXX,NYY,MASK(1),
+ MASKREJ(1),IDR)
C
C If fitting an overload, an edge reflection or a reflection with
C rejected peak pixels (due to overlapping spots) copy PROFSUMS into
C a local array as it will be updated
C
IF (OVRLFIT.OR.EDGEFIT.OR.PEAKREJ) THEN
DO 2 I=1,4
PROFSUML(I) = PROFSUMS(I)
WPROFSUML(I) = WPROFSUMS(I)
2 CONTINUE
END IF
C
C
DO 5 I=1,18
5 ASPOT(I) = 0.0
IJ = 0
SPKPOD = 0
SPKQOD = 0
SPKOD = 0
SPKODSQ = 0
SBGPOD = 0
SBGQOD = 0
SBGOD = 0
SUMPROD = 0
IF (DEBUG(34).AND.SPOT.AND.(NDBG.LE.NDEBUG(34)))
+ CALL ODPLOT4(OD(1),NXX,NYY,IDR,MAXPIX)
C
C
DO 40 P = -HX,HX
DO 30 Q = -HY,HY
IJ = IJ + 1
C
C---- Set LMASK to 1 for all pixels in box, modified later to zero
C for background pixels overlapped by neighbouring spots,
C to 2 for peak pixels overlapped by neighbouring spots,
C and to -1 for pixels next to these overlapped pixels, and to zero
C for background outliers, and -2 for pixels adjacent to -1 pixels
C if DECONV set TRUE.
C
LMASK(IJ) = 1
IOD = OD(IJ)
C
C
IF (MASK(IJ).EQ.0) THEN
GO TO 30
ELSE IF (MASK(IJ).GT.0) THEN
GO TO 20
END IF
C
C---- Sums for background
C
10 SBGOD = SBGOD + IOD
SBGPOD = P*IOD + SBGPOD
SBGQOD = Q*IOD + SBGQOD
GO TO 30
C
C---- Sums for peak
C
20 SPKOD = SPKOD + IOD
C
30 CONTINUE
40 CONTINUE
C IF (DEBUG(34)) WRITE(6,*),'END OF LOOP, NBR,ASPOT',NBREJ,ASPOT
C
C---- Background constants
C
IF (NBREJ.EQ.0) THEN
A = SBGPOD/PQVAL(2)
B = SBGQOD/PQVAL(4)
C = SBGOD/PQVAL(6)
ELSE
C
C---- Now set LMASK zero for rejected background pixels from CHANGEMASK
C
DO 42 N = 1,NBREJ
IJ = MASKREJ(N+1)
LMASK(IJ) = 0
42 CONTINUE
C
C **************************
CALL MATVEC(ABC,PQSUMINV,SPQOD)
C **************************
C
A = ABC(1)
B = ABC(2)
C = ABC(3)
END IF
C
C
ASPOT(6) = SBGPOD
ASPOT(7) = SBGQOD
ASPOT(8) = SBGOD
ASPOT(9) = A
ASPOT(10) = B
ASPOT(11) = C
IF (DEBUG(34).AND.(NDBG.LE.NDEBUG(34))) THEN
WRITE(IOUT,FMT=6010) NBREJ,NREJP,PQSUMINV,PQVAL,ASPOT
IF (ONLINE) WRITE(ITOUT,FMT=6010) NBREJ,NREJP,
+ PQSUMINV,PQVAL,ASPOT
6010 FORMAT(/1X,'***DEBUG OUTPUT FROM INTEG2 ***',/,1X,
+ 'NBREJ',I5,' NREJP',I3,' PQSUMINV',9F12.8,/,1X,
+ 'PQVAL',6F10.1,/,1X,
+ 'Contents of ASPOT after solving for',
+ 'background',(/1X,5F12.1))
NDBG = NDBG + 1
END IF
C
C---- Copy pqsums to a local array because they will be updated in
C BGTEST called from EVAL
C
DO 50 K = 1,6
SPOTPQSUM(K) = PQSUMS(K)
50 CONTINUE
C
C Set maximum allowed number of allowed background pixels to be
C rejected from background plane determination. Must use PQSUMS
C here in case background pixels have already been rejected by
C CHANGEMASK...these pixels are not tested again.
C
NRLMAX = NINT(PQSUMS(6)) - NBGMIN
C
C---- Tets for too few background points
C
IF (NRLMAX.LT.0) THEN
ASPOT(1) = -9999.0
RETURN
END IF
C
C---- Determine the optimum background plane constants, allowing
C for the possibility of adjacent spots intruding into the background
C Returns improved estimates for "A,B,C" via ASPOTS
C
C ***********************************************
CALL EVAL(OD(1),MASK(1),IRAS,SPOTPQSUM,BGSIG,NRLMAX,NRFL,
+ MASKREJO,DEBUG(34),MODE)
C ***********************************************
C
IF (DEBUG(34).AND.(NDBG.LE.NDEBUG(34))) THEN
WRITE(IOUT,FMT=6020) MASKREJO(1),NRLMAX,ASPOT
IF (ONLINE) WRITE(ITOUT,FMT=6020) MASKREJO(1),NRLMAX,ASPOT
6020 FORMAT(1X,'In INTEG2, NBREJ, NRLMAX',2I5,/,1X,
+ 'Contents of ASPOT after calling EVAL'
+ ,(/1X,5F12.1))
END IF
C
C---- Check that not too many background points have been rejected
C (Flagged by NRLMAX=-999)
C
IF (NRLMAX.EQ.-999) THEN
ASPOT(1) = -9999.0
RETURN
END IF
C
C---- Total background under peak (assuming peak has mm symmetry)
C
ASPOT(2) = PQVAL(5)*C
C
C---- Summation integration intensity
C
ASPOT(1) = SPKOD - ASPOT(2)
C
C ASPOT(2) is used in calculation of counting statistics errors.
C Must subtract scanner adc offset here (stored in IDIVIDE). For summed
C partials, must subtract twice the offset
C
IF (ISUMPART.EQ.1) THEN
MULT = 2
ELSE
MULT = 1
END IF
ASPOT(2) = ASPOT(2) - PQVAL(5)*IDIVIDE*MULT
C
C---- Number of additional (to CHANGEMASK) rejected background pixels
C
ASPOT(15) = MASKREJO(1)
C
C---- Now evaluate profile fitted intensity. Note that weighted profile
C fit requires a knowledge of the summation integration intensity
C and the plane constants
C
WSCAL = ASPOT(1)/PROFSUMS(3)
C
C---- If WSCAL is negative (ie integrated intensity is negative) then
C set to zero
C
IF (WSCAL.LT.0.0) WSCAL = 0.0
C
C---- For partials, correct WSCAL for the degree of partiality. This may
C introduce a significant error into the estimate of the integrated
C intensity for spots that are only just recorded (ie are mostly on
C the abutting image) but the contribution to the total intensity for
C such spots will only be very small anyway, so an error in the
C weighting will have a negligable effect
C
PART = ABS(REAL(IPART))
IF (.NOT.FULL) WSCAL = WSCAL/(0.01*PART)
C
C
C---- Now set LMASK TO 2 for rejected peak pixels
C
IF (PEAKREJ) THEN
DO 52 N = 1,NREJP
IJ = MASKREJP(N+1)
LMASK(IJ) = 2
52 CONTINUE
END IF
C
C---- Now set LMASK to -1 for pixels adjacent to rejected peak and
C background pixels due to overlap by neighbouring spots.
C If DECONV is TRUE set pixels adjacent to -1 pixels to -2.
C
IF (DECONV) THEN
MODEP = 2
ELSE
MODEP = 1
END IF
C
CALL PIXOVERLAP(MODEP,LMASK,NXX,NYY,HX,HY)
C
C---- Now set LMASK zero for additional rejected background pixels
C returned from EVAL
C
NREJ = MASKREJO(1)
IF (NREJ.GT.0) THEN
DO 54 N = 1,NREJ
IJ = MASKREJO(N+1)
LMASK(IJ) = 0
54 CONTINUE
END IF
C---- Print LMASK if debugging
C
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6050)
IF (ONLINE) WRITE(ITOUT,FMT=6050)
6050 FORMAT(/,1X,'Array LMASK after calling PIXOVERLAP',/,1X,
+ 'Overlapped or background outlier pixels: 0, pixels',
+ ' adjacent to overlapped pixels: -1',/,1X,'Overlapped',
+ ' peak pixels: 2, OK pixels: 1, Adjacent to adjacent to',
+ ' overlapped pixels -2')
CALL ODPLOT4(LMASK(1),NXX,NYY,IDR,MAXPIX)
END IF
C
56 SWPPR = 0
SWQPR = 0
SWPR = 0
SWPRSQ = 0
SWPSQ = 0
SWPQ = 0
SWP = 0
SWQSQ = 0
SWQ = 0
SW = 0
SWPOD = 0
SWQOD = 0
SWOD = 0
SWPROD = 0
C
IJ = 0
C
DO 70 P = -HX,HX
DO 60 Q = -HY,HY
IJ = IJ + 1
IOD = OD(IJ)
C
C---- Consider ALL pixels except rejected background ones
C LMASK has values:
C -2 pixels adjacent to pixels flagged as -1 (only if DECONV)
C -1 pixels next to overlapped pixels
C 0 background pixels rejected either as overlapped or as
C outliers
C 1 OK pixels (can be peak or background)
C 2 overlapped peak pixels or rejected outlier peak pixels
C
IF (LMASK(IJ).EQ.0) GOTO 60
C
C---- If only fitting peak pixels, test this too
C
IF (PKONLY.AND.(MASK(IJ).NE.1)) GOTO 60
C
C---- Check for fitting an overload or reflection partially outside
C scanned area
C
IF ((OVRLFIT.AND.(IOD.GT.CUTOFF)).OR.
+ (EDGEFIT.AND.(IOD.LE.NULLPIX)).OR.
+ (PEAKREJ.AND.(LMASK(IJ).EQ.2))) THEN
IF (MASK(IJ).GT.0) THEN
IPROFIJ = IPROFL(IJ)
PROFSUML(1) = PROFSUML(1) - P*IPROFIJ
PROFSUML(2) = PROFSUML(2) - Q*IPROFIJ
PROFSUML(3) = PROFSUML(3) - IPROFIJ
PROFSUML(4) = PROFSUML(4) - IPROFIJ*IPROFIJ
END IF
ELSE
C
C---- Unweighted sums for peak pixels only
C
IF (MASK(IJ).GT.0) THEN
SUMPROD = REAL(IPROFL(IJ))*REAL(IOD) + SUMPROD
SPKODSQ = REAL(IOD)*REAL(IOD) + SPKODSQ
END IF
C
C---- Sums for weighted profile fit
C
IF (WEIGHT) THEN
C
C---- Weight is inverse of expectation value of counts at this pixel
C
IPROFIJ = IPROFL(IJ)
IF (IPROFIJ.GE.0) THEN
WT = GAIN*(A*P+B*Q+C+WSCAL*IPROFIJ)
ELSE
WT = GAIN*(A*P+B*Q+C)
END IF
IF (WT.NE.0) WT = 1.0/WT
C
C---- If deconvoluting adjacent peaks, correct the weight.
C For first tests, simply set weight to zero for edge pixels
C adjacent to overlapped background pixels
C
IF (DECONV.AND.(LMASK(IJ).LE.-1)) WT = 0.0
C
CAL IF (XDEBUG) WRITE(6,*),'Using pixel',P+HX+1,Q+HY+1,IOD,WT
C
WTPR = IPROFL(IJ)*WT
SWPPR = P*WTPR + SWPPR
SWQPR = Q*WTPR + SWQPR
SWPR = SWPR + WTPR
CAL SWPRSQ = WTPR*WTPR/WT + SWPRSQ
SWPRSQ = WTPR*IPROFL(IJ) + SWPRSQ
SWPSQ = SWPSQ + WT*P*P
SWPQ = SWPQ + WT*P*Q
SWP = SWP + WT*P
SWQSQ = SWQSQ + WT*Q*Q
SWQ = SWQ + WT*Q
SW = SW + WT
SWPOD = WT*P*IOD + SWPOD
SWQOD = WT*Q*IOD + SWQOD
SWOD = WT*IOD + SWOD
SWPROD = WTPR*IOD + SWPROD
END IF
END IF
C
C
IF ((FULL).AND.(MASK(IJ).GT.0).AND.
+ (.NOT.(OVRLFIT.OR.EDGEFIT.OR.PEAKREJ))) THEN
C
C---- Sums for c of g shift and profile sigma
C
SPKPOD = IOD*P + SPKPOD
SPKQOD = IOD*Q + SPKQOD
END IF
C
60 CONTINUE
70 CONTINUE
C
C---- Profile fitted intensity
C
C
C
IF (WEIGHT) THEN
C
C---- First evaluate PEAKVAR used to calculate PKRATIO
C This is done using the old formulation, and does not involve weights
C **** No longer used ***
CAL XI = (SUMPROD-PROFSUMS(1)*A-PROFSUMS(2)*B-
CAL + PROFSUMS(3)*C)*PROFSUMS(3)/PROFSUMS(4)
CAL
CAL XJ = XI/PROFSUMS(3)
C ASPOT(14) = XJ*XJ*PROFSUMS(4) + A*A*PQVAL(1) + B*B*PQVAL(3) +
C + C*C*PQVAL(5) + SPKODSQ +
C + 2*XJ* (PROFSUMS(1)*A+PROFSUMS(2)*B+PROFSUMS(3)*C-
C + SUMPROD) - 2*A*SPKPOD - 2*B*SPKQOD - 2*C*SPKOD
C
C
PMAT(1,1) = SWPRSQ
PMAT(1,2) = SWPPR
PMAT(1,3) = SWQPR
PMAT(1,4) = SWPR
C
PMAT(2,1) = SWPPR
PMAT(2,2) = SWPSQ
PMAT(2,3) = SWPQ
PMAT(2,4) = SWP
C
PMAT(3,1) = SWQPR
PMAT(3,2) = SWPQ
PMAT(3,3) = SWQSQ
PMAT(3,4) = SWQ
C
PMAT(4,1) = SWPR
PMAT(4,2) = SWP
PMAT(4,3) = SWQ
PMAT(4,4) = SW
C
X(1) = SWPROD
X(2) = SWPOD
X(3) = SWQOD
X(4) = SWOD
C
C---- The four by four matrix solves for the scale factor to scale this
C reflection to the standard profile and the 3 background plane
C constants
C
ZEROD = .FALSE.
CALL MINV4(PMAT,PMATI,IERR)
C
C---- Check for zero determinant
C
IF (IERR.GT.0) THEN
ZEROD = .TRUE.
GOTO 74
END IF
CALL MATVEC4(XR,PMATI,X)
PSCALE = XR(1)
AS = XR(2)
BS = XR(3)
CS = XR(4)
ASPOT(13) = XR(1)*WPROFSUMS(3)
C
C---- For partials, cannot allow the background plane parameters to
C be determined from profile fit to whole box, use those
C determined from the (non-rejected) background pixels
C
C---- Also allow this as an option to deal with cases where the profile
C values are not zero even in the background region, because of
C high spot density (CLOSE option)
C
C---- Also use this route if the determinant of 4x4 matrix was zero !
C
74 IF ((.NOT.FULL).OR.PKONLY.OR.ZEROD) THEN
AS = A
BS = B
CS = C
IF (SWPRSQ.NE.0.0) THEN
PSCALE = (SWPROD - A*SWPPR - B*SWQPR - C*SWPR)/SWPRSQ
ELSE
PSCALE = 0.0
END IF
ASPOT(13) = PSCALE*WPROFSUMS(3)
IF (PKONLY) ASPOT(13) = PSCALE*PROFSUMS(3)
END IF
IF (DEBUG(34).AND.(NDBG.LE.NDEBUG(34))) THEN
WRITE(IOUT,FMT=6024) A,B,C,AS,BS,CS,ASPOT(13),IPASS,
+ PSCALE,WSCAL,NBADP,PQVAL(5)
IF (ONLINE) WRITE(ITOUT,FMT=6024) A,B,C,AS,BS,CS,
+ ASPOT(13),IPASS,PSCALE,WSCAL,NBADP,PQVAL(5)
END IF
6024 FORMAT(1X,'Old plane constants',2F9.2,
+ F9.1,/,1X,'New plane constants and profile',
+ ' intensity',2F9.2,F8.1,F8.0,/,1X,'IPASS=',I1,
+ ' PSCALE',F8.5, ' WSCAL',F8.5,' Number of flagged',
+ ' peak pixels',I3,' number of peak pixels',F4.0)
C
C---- Now need to loop over all pixels again to evaluate sum(w*deltasq)
C required for sigma calculations
C
IJ = 0
NPIX = 0
SWDELSQ = 0.0
SDELSQ = 0.0
C
DO 90 P = -HX,HX
RHOC1 = P*AS + CS
DO 80 Q = -HY,HY
IJ = IJ + 1
C
C---- Consider ALL pixels except rejected background ones
C
IF (LMASK(IJ).EQ.0) GOTO 80
C
C---- Reject non-peak pixels if only fitting peak pixels
C
IF (PKONLY.AND.(MASK(IJ).NE.1)) GOTO 80
C
IOD = OD(IJ)
RHOC = RHOC1 + Q*BS + PSCALE*IPROFL(IJ)
DEL = (REAL(IOD) - RHOC)
C
C---- Check for fitting an overload or reflection partially outside
C scanned area
C
IF ((OVRLFIT.AND.(IOD.GT.CUTOFF)) .OR.
+ (EDGEFIT.AND.(IOD.LE.NULLPIX)) .OR.
+ (PEAKREJ.AND.(LMASK(IJ).EQ.2))) THEN
GOTO 80
ELSE
C
C---- Weight is inverse of expectation value of counts at this pixel
C (Must use same weights here as in previous loop, ie do not use
C updated A,B,C
C
IPROFIJ = IPROFL(IJ)
IF (IPROFIJ.GE.0) THEN
WT = GAIN*(A*P+B*Q+C+WSCAL*IPROFIJ)
ELSE
WT = GAIN*(A*P+B*Q+C)
END IF
CAL IF (WT.LE.0.0) WRITE(6,*),'ZERO/NEG WT,WSCAL,NPIX,IJ,IPART',
CAL + WT,WSCAL,NPIX,IJ,IPART
IF (WT.NE.0) WT = 1.0/WT
C
C---- If deconvoluting adjacent peaks, correct the weight.
C For first tests, simply set weight to zero for edge pixels
C adjacent to overlapped background pixels
C
IF (DECONV.AND.(LMASK(IJ).LE.-1)) WT = 0.0
C
WDELSQ = WT*DEL*DEL
IF (WDELSQ.GT.0) WDEL = SQRT(WDELSQ)
C
C---- Outlier detection (eg speckles in Mar scanners)
C
SSIGN = (((DEL.LT.0).AND.(PKWDOUTL.LT.0)).OR.
+ ((DEL.GT.0).AND.(PKWDOUTL.GT.0)))
SSIGN = (SSIGN.AND.(WDEL.GT.APKWDOUTL))
INRANGE = ((IOD.GE.IOUTL1).AND.(IOD.LE.IOUTL2))
SWDELSQ = SWDELSQ + WDELSQ
C
C---- Flag any peak pixels that fit particularly badly
C
IF ((MASK(IJ).GT.0).AND.((WDEL.GT.PKWDLIM1).OR.
+ (WDEL.GT.PKWDLIM2).OR.
+ (SSIGN.AND.INRANGE))) THEN
+
C
C On the first pass, only flag pixels that are adjacent to
C overlapped pixels and outliers
C
IF (IPASS.EQ.0) THEN
BADPIX = .TRUE.
IF (((LMASK(IJ).LE.-1).AND.
+ (WDEL.GT.PKWDLIM2)).OR.
+ (SSIGN.AND.INRANGE)) THEN
NBADP = NBADP + 1
LMASKREJP(NBADP+1) = IJ
END IF
ELSE
C On second or subsequent passes, reject any pixel, but note
C different tests are done for pixels with neighbouring overlapped
C pixels and the rest. Do NOT allow rejections for partials
C as these are not expected to fit.
C
IF (((LMASK(IJ).LE.-1).AND.
+ (WDEL.GT.PKWDLIM2)).OR.
+ (FULL.AND.(WDEL.GT.PKWDLIM1)).OR.
+ (SSIGN.AND.INRANGE)) THEN
NBADP = NBADP + 1
LMASKREJP(NBADP+1) = IJ
END IF
END IF
END IF
C
C---- Sum of del**2 for non-rejected peak pixels only, use in PKRATIO
C
IF (MASK(IJ).GT.0) SDELSQ = SDELSQ + DEL*DEL
NPIX = NPIX + 1
END IF
C
C---- End of loop over pixels
C
80 CONTINUE
90 CONTINUE
C
C---- If there are not too many very badly fitting pixels, repeat profile
C fit rejecting these pixels. Only allow this if not more than 1/3rd
C of pixels has been flagged. Otherwise there is probably something wrong
C with this spot.
C
LMASKREJP(1) = NBADP
IF ((NBADP-NBADSAVE).GT.0) THEN
IF (NBADP.LT.NINT(0.33*PQVAL(5))) THEN
DO 100 I = 1,NBADP
IJ = LMASKREJP(I+1)
LMASK(IJ) = 2
100 CONTINUE
PEAKREJ = .TRUE.
IPASS = IPASS + 1
NBADSAVE = NBADP
IF (IPASS.LE.2) GOTO 56
ELSE
C
C---- Too many pixels rejected
C
IF (DEBUG(34).AND.(NDBG.LE.NDEBUG(34))) THEN
WRITE(IOUT,FMT=6060) NBADP
IF (ONLINE) WRITE(ITOUT,FMT=6060) NBADP
6060 FORMAT(/,1X,'Profile fit too poor to allow further ',
+ 'pixel rejection, number rejected is',I4,/)
END IF
NBADP = NBADSAVE
LMASKREJP(1) = NBADP
GOTO 110
END IF
END IF
C
C---- If there are badly fitting pixels not next to overlapped pixels
C then these should be rejected on a second pass, if this has not
C been initiated by badly fitting pixels next to overlapped pixels
C
IF (BADPIX) THEN
IPASS = IPASS + 1
BADPIX = .FALSE.
GOTO 56
END IF
C
C---- Calculate the variance in profile scale factor PSCALE and hence the
C variance in the profile fitted intensity
C
110 IF (FULL.AND.(DEBUG(34)))
+ WRITE(6,*)'SWDELSQ,INT',SWDELSQ/(NPIX-4.0),ASPOT(13)
IF (NPIX.GT.4) THEN
C
C---- Apparently need to scale up the sum of del**2 (by 1.4)
C to get PKRATIO of 1 for "ideal" cases. However, in other cases
C this gives rather too many badspots rejected on PKRATIO,
C so do not scale up for time being.
C Note that ASPOT(14) is also used to calculate the profile fitted
C sigma in the PKONLY case.
C
ASPOT(14) = 1.0*SDELSQ
C
DEL = SWDELSQ*PMATI(1,1)/REAL(NPIX-4)
ASPOT(16) = DEL*WPROFSUMS(3)*WPROFSUMS(3)
ELSE
ASPOT(14) = 1.0*SDELSQ
DEL = 0.0
IF (NPIX.GT.0) DEL = SWDELSQ*PMATI(1,1)/REAL(NPIX)
ASPOT(16) = DEL*WPROFSUMS(3)*WPROFSUMS(3)
BADSPOT = .TRUE.
CAL WRITE(IOUT,FMT=6030) NPIX
CAL IF (ONLINE) WRITE(ITOUT,FMT=6030) NPIX
6030 FORMAT(1X,'*** FATAL ERROR ***',/,1X,' There are only',I3,
+ ' pixels being used to evaluate the background plane constants',
+ /,1X,'and profile fitted intensity for this reflection',/,1X,
+ 'This is not sufficient to determine these parameters')
CAL CALL SHUTDOWN
END IF
C
C---- Update the background plane constants to those calculated from the
C 4*4 matrix fit.
C
A = AS
B = BS
C = CS
C
C---- If profile fitting overloaded reflections or "edge" reflections
C set PEAKVAR to zero and set the summation integration intensity to the
C profile fitted intensity
C
IF (OVRLFIT.OR.EDGEFIT) THEN
ASPOT(14) = 0.0
ASPOT(1) = ASPOT(13)
END IF
C
ELSE
C
C---- UNWEIGHTED profile fitting, use original formulation
C
ASPOT(13) = (SUMPROD-PROFSUMS(1)*A-PROFSUMS(2)*B-
+ PROFSUMS(3)*C)*PROFSUMS(3)/PROFSUMS(4)
C
C---- Profile peak sigma
C
XJ = ASPOT(13)/PROFSUMS(3)
ASPOT(14) = XJ*XJ*PROFSUMS(4) + A*A*PQVAL(1) + B*B*PQVAL(3) +
+ C*C*PQVAL(5) + SPKODSQ +
+ 2*XJ* (PROFSUMS(1)*A+PROFSUMS(2)*B+PROFSUMS(3)*C-
+ SUMPROD) - 2*A*SPKPOD - 2*B*SPKQOD - 2*C*SPKOD
C
C---- Overload fitting, use PROFSUML instead
C
IF (OVRLFIT.OR.EDGEFIT.OR.PEAKREJ) THEN
ASPOT(13) = (SUMPROD-PROFSUML(1)*A-PROFSUML(2)*B-
+ PROFSUML(3)*C)*PROFSUMS(3)/PROFSUML(4)
ASPOT(14) = 0.0
ASPOT(1) = ASPOT(13)
END IF
C
END IF
C
IF (FULL.AND.(.NOT.(OVRLFIT.OR.EDGEFIT))) THEN
C
C----- Catch zero spots
C
IF (ASPOT(1).NE.0.0) THEN
C
C---- C of g shifts, delx and dely, fully recorded only
C
ASPOT(4) = (SPKPOD-PQVAL(1)*A)/ASPOT(1)*IDR
ASPOT(5) = (SPKQOD-PQVAL(3)*B)/ASPOT(1)
C
ELSE
ASPOT(4) = 0.0
ASPOT(5) = 0.0
END IF
END IF
C
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6040) ASPOT
IF (ONLINE) WRITE(ITOUT,FMT=6040) ASPOT
6040 FORMAT(1X,'Final values in ASPOT on returning from INTEG2',/,
+ (1X,6F12.0))
END IF
IF (XDEBUG) DEBUG(34) = .FALSE.
XDEBUG = .FALSE.
C
END
C== INTEG3 ==
SUBROUTINE INTEG3(OD,IRAS,MASK,PQVAL,PQSUMS,PQSUMINV,NBREJ,
+ MASKREJ,BGSIG,CDEBUG)
C ================================================================
IMPLICIT NONE
C
C
C
C---- Determine background plane constants for fully recorded reflections
C to be included in the weighted profiles. Makes use of the MASK
C which has ALREADY had overlapped background pixels rejected (by
C S/R MASKIT).
C Note that PQVAL is set up IGNORING rejected background
C pixels (it is done by SETSUMS), so elements 2,4,6 will be wrong if
C background pixels have been rejected. However PQSUMS allows for
C rejected background pixels, but PQSUMS and PQSUMINV must have
C been set up BEFORE calling this subroutine, and are NOT updated
C by this subroutine.
C
C MASK is an integer array denoting the status of each pixel.
C Its values are NOT changed.
C Values in MASK are:
C
C -1 Background pixel
C 0 Rejected background pixel (overlapped by neighbouring spot)
C 1 Peak pixel
C
C NBREJ Number of rejected background pixels. Not Updated
C
C Elements of PQVAL (This array is NOT updated)
C p,q are pixel coords wrt centre of box
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C Elements of PQSUMS (This array is NOT updated, but is copied into
C a local array SPOTPQSUM which is updated for every spot based
C on rejected background pixels (done in BGTEST))
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY.
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C Elements of ASPOT (This array IS updated)
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL BGSIG
INTEGER NBREJ
LOGICAL CDEBUG
C ..
C .. Array Arguments ..
REAL PQSUMINV(3,3),PQSUMS(6),PQVAL(6)
INTEGER IRAS(5),MASK(MAXBOX),OD(MAXBOX),MASKREJ(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,B,C,RMSBG,SBGOD,SBGPOD,SBGQOD,
+ SPKOD,SPKODSQ,SPKPOD,SPKQOD,SUMPROD,SWPR,SWPPR,SWPRSQ,
+ SWQPR,SWPSQ,SWPQ,SWP,SWQSQ,SWQ,SW,SWPOD,SWQOD,SWOD,SWPROD,
+ WT,WTPR,XJ,BGDEVMAX,WSCAL,PART,AS,BS,CS,XI,RHOC,RHOC1,PSCALE,
+ SWDELSQ,DEL,TPOD,TQOD
INTEGER HX,HY,IJ,IOD,K,P,Q,NRLMAX,NRFL,IPROFIJ,I,NXX,NYY,NDBG,
+ NREJ,NPIX,N,MODE,MAXPIX
LOGICAL DEBUGEV,XDEBUG
C ..
C .. Local Arrays ..
REAL ABC(3),SPOTPQSUM(6),SPQOD(3),PROFSUML(4),PMAT(4,4),
+ PMATI(4,4),X(4),XR(4),WPROFSUML(4)
C ..
C .. External Subroutines ..
EXTERNAL ODPLOT4,EVAL,MATVEC
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (SPQOD(1),SBGPOD), (SPQOD(2),SBGQOD), (SPQOD(3),SBGOD)
EQUIVALENCE (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(6),SBGPOD)
EQUIVALENCE (ASPOT(7),SBGQOD), (ASPOT(8),SBGOD), (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C), (ASPOT(12),BGDEVMAX)
C ..
SAVE
C
DATA NDBG/0/
C
MAXPIX = 0
XDEBUG = (CDEBUG.AND.(DEBUG(46)))
C
C
C---- Mode for EVAL (signifies we have not flagged overlapped background
C pixels)
MODE = 0
NRFL = 1
HX = IRAS(1)/2
HY = IRAS(2)/2
C
DO 5 I=1,18
5 ASPOT(I) = 0.0
IJ = 0
N = 0
TPOD = 0
TQOD = 0
SPKPOD = 0
SPKQOD = 0
SPKOD = 0
SPKODSQ = 0
SBGPOD = 0
SBGQOD = 0
SBGOD = 0
SUMPROD = 0
C
C
DO 40 P = -HX,HX
DO 30 Q = -HY,HY
IJ = IJ + 1
IOD = OD(IJ)
C
C
IF (MASK(IJ).EQ.0) THEN
GO TO 30
ELSE IF (MASK(IJ).GT.0) THEN
GO TO 20
END IF
C
C---- Sums for background
C
10 SBGOD = SBGOD + IOD
SBGPOD = P*IOD + SBGPOD
SBGQOD = Q*IOD + SBGQOD
N = N + 1
GO TO 30
C
C---- Sums for peak
C
20 SPKOD = SPKOD + IOD
TPOD = P*IOD + TPOD
TQOD = Q*IOD + TQOD
C
30 CONTINUE
40 CONTINUE
IF (XDEBUG.AND.(NDBG.LE.NDEBUG(46))) THEN
WRITE(IOUT,FMT=6002) NBREJ,N,PQVAL
IF (ONLINE) WRITE(ITOUT,FMT=6002) NBREJ,N,PQVAL
6002 FORMAT(//1X,'INTEG3: NBREJ,NBKG,PQVAL',2I8,6F10.0)
END IF
C
C---- Background constants
C
IF (NBREJ.EQ.0) THEN
A = SBGPOD/PQVAL(2)
B = SBGQOD/PQVAL(4)
C = SBGOD/PQVAL(6)
ELSE
C **************************
CALL MATVEC(ABC,PQSUMINV,SPQOD)
C **************************
C
A = ABC(1)
B = ABC(2)
C = ABC(3)
END IF
C
C
ASPOT(6) = SBGPOD
ASPOT(7) = SBGQOD
ASPOT(8) = SBGOD
ASPOT(9) = A
ASPOT(10) = B
ASPOT(11) = C
IF (XDEBUG.AND.(NDBG.LE.NDEBUG(46))) THEN
WRITE(IOUT,FMT=6010) PQSUMINV,ASPOT
IF (ONLINE) WRITE(ITOUT,FMT=6010) PQSUMINV,ASPOT
6010 FORMAT(1X,'In INTEG3, Contents of PQSUMINV:',/,1X,9F12.8,
+ /,1X,'ASPOT after solving for',
+ 'background',(/1X,5F12.1))
NDBG = NDBG + 1
END IF
C
C---- Copy PQSUMS to a local array because they will be updated in
C BGTEST called from EVAL
C
DO 50 K = 1,6
SPOTPQSUM(K) = PQSUMS(K)
50 CONTINUE
C
C Set maximum allowed number of allowed background pixels to be
C rejected from background plane determination. Must use PQSUMS
C here in case background pixels have already been rejected by
C CHANGEMASK...these pixels are not tested again.
C
NRLMAX = NINT(PQSUMS(6)) - NBGMIN
C
C---- Tets for too few background points
C
IF (NRLMAX.LT.0) THEN
ASPOT(1) = -9999.0
RETURN
END IF
C
C---- Determine the optimum background plane constants, allowing
C for the possibility of adjacent spots intruding into the background
C Returns improved estimates for "A,B,C" via ASPOTS
C
C Only allow debug output from EVAL if it is turned on in the
C subroutine that calls INTEG3
C
DEBUGEV = (XDEBUG.AND.CDEBUG)
C ***********************************************
CALL EVAL(OD(1),MASK(1),IRAS,SPOTPQSUM,BGSIG,NRLMAX,NRFL,
+ MASKREJ,DEBUGEV,MODE)
C ***********************************************
C
IF (XDEBUG.AND.(NDBG.LE.NDEBUG(46))) THEN
WRITE(IOUT,FMT=6020) MASKREJ(1),NRLMAX,ASPOT
IF (ONLINE) WRITE(ITOUT,FMT=6020) MASKREJ(1),NRLMAX,ASPOT
6020 FORMAT(1X,'In INTEG3, additional pixels rejected as outliers',
+ I5,', NRLMAX',I5,/,1X,
+ 'Contents of ASPOT after calling EVAL'
+ ,(/1X,5F12.1)/)
IF (SPOT) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
6000 FORMAT(//,1X,'Dumping reflection from INTEG3')
CALL PLOTSPOT(OD(1),IRAS,MASK,MASKREJ)
END IF
END IF
C
C---- Check that not too many background points have been rejected
C (Flagged by NRLMAX=-999)
C
IF (NRLMAX.EQ.-999) THEN
ASPOT(1) = -9999.0
RETURN
END IF
C
C---- Total background under peak (assuming peak has mm symmetry)
C
ASPOT(2) = PQVAL(5)*C
C
C---- Summation integration intensity
C
ASPOT(1) = SPKOD - ASPOT(2)
C
C ASPOT(2) is used in calculation of counting statistics errors.
C Must subtract scanner adc offset here (stored in IDIVIDE)
C
ASPOT(2) = ASPOT(2) - PQVAL(5)*IDIVIDE
C
C---- Number of additional (to CHANGEMASK) rejected background pixels
C
ASPOT(15) = MASKREJ(1)
C
C---- Centre of gravity. This assumes mm symmetry for peak.
C
IF (ASPOT(1).NE.0.0) THEN
ASPOT(4) = (TPOD-PQVAL(1)*A)/ASPOT(1)
ASPOT(5) = (TQOD-PQVAL(3)*B)/ASPOT(1)
ELSE
ASPOT(4) = 0.0
ASPOT(5) = 0.0
END IF
END
C== INTERP ==
SUBROUTINE INTERP(MASK,NX,NY,DX,DY,ISX,ISY,NOXRIM,NOYRIM,LEN)
C =============================================================
C
IMPLICIT NONE
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL DX,DY
INTEGER ISX,ISY,LEN,NX,NY
LOGICAL NOXRIM,NOYRIM
C ..
C .. Array Arguments ..
INTEGER MASK(MAXBOX)
C ..
C .. Scalars in Common ..
INTEGER IOD
C ..
C .. Arrays in Common ..
INTEGER*2 BBINT,BBSAVE
C ..
C .. Local Scalars ..
REAL DDX,DDY
INTEGER HX,HY,IJ,IND,IOD1,IOD2,IOD3,IOD4,NNDBG,NYADD,P,Q,
+ NXY,I
LOGICAL XNEG,YNEG
C ..
C .. External Subroutines ..
EXTERNAL GETBYTE ,PACKBYTE
C ..
C .. Extrinsic Functions ..
INTEGER INTPXL,PUTPXL
EXTERNAL INTPXL,PUTPXL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
COMMON /BITS/IOD,BBSAVE(MAXBOX),BBINT(MAXBOX)
C ..
SAVE
C .. Data statements ..
DATA NNDBG/0/
C ..
C
C
NNDBG = NNDBG + 1
XNEG = (ISX.LT.0)
YNEG = (ISY.LT.0)
HX = NX/2
HY = NY/2
IJ = 0
DDY = 1.0 - DY
DDX = 1.0 - DX
NYADD = ISX*NY
IND = (NNDBG/100)*100
cc?? if (NNDBG.eq.ind) write(6,201) nx,ny,isx,nyadd,dx,dy
201 FORMAT(1X,'NX,NY',2I4,' ISX,NYADD',2I4,' DX,DY',2F5.2)
C
C
DO 20 P = -HX,HX
IF (NOXRIM) THEN
C
C
IF ((XNEG.AND. (P.EQ.-HX)) .OR.
+ ((.NOT.XNEG).AND. (P.EQ.HX))) THEN
IJ = IJ + NY
GO TO 20
END IF
C
C
END IF
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
C
C
IF (NOYRIM) THEN
IF (((Q.EQ.-HY).AND.YNEG) .OR.
+ ((Q.EQ.HY).AND. (.NOT.YNEG))) GO TO 10
END IF
C
C
IF (MASK(IJ).GT.0) THEN
C
C---- Peak area, do interpolation, first unpack bytes if required
C
IF (IMGP) THEN
IOD = INTPXL(BBSAVE(IJ))
ELSE
C ***********
CALL GETBYTE(IJ)
C ***********
END IF
C
IOD1 = IOD
C
C---- Trap spots with zero pixels
IF (IOD1.LE.0) GO TO 30
C
IF (IMGP) THEN
IOD2 = INTPXL(BBSAVE(IJ+ISY))
IOD3 = INTPXL(BBSAVE(IJ+NYADD))
IOD4 = INTPXL(BBSAVE(IJ+ISY+NYADD))
ELSE
C ***************
CALL GETBYTE(IJ+ISY)
C ***************
IOD2 = IOD
C *****************
CALL GETBYTE(IJ+NYADD)
C *****************
IOD3 = IOD
C *********************
CALL GETBYTE(IJ+ISY+NYADD)
C *********************
IOD4 = IOD
END IF
IOD = DDX*DDY*IOD1 + DDX*DY*IOD2 + DX*DDY*IOD3 +
+ DX*DY*IOD4 + 0.5
cc?? if (NNDBG.eq.ind) write(6,200) p,q,iod,iod1,iod2,iod3,iod4
200 FORMAT(1X,'P,Q',2I4,' IOD=',I3,' IOD1,2,3,4',4I4)
C
IF (IMGP) THEN
IOD = PUTPXL(IOD)
BBINT(IJ) = IOD
ELSE
C ************
CALL PACKBYTE(IJ)
C ************
END IF
C
END IF
10 CONTINUE
20 CONTINUE
C
RETURN
C
C---- Overloaded reflection, or reflection with pixel values of zero
C (ie extends beyond scanned area in image plate) ... do not interpolate
C Need to copy all pixel values (in BBSAVE) into BBINT because some
C pixels may already have been interpolated.
C
30 CONTINUE
NXY = NX*NY
IF (DEBUG(17)) THEN
C ***********************************
IF (SPOT) CALL ODPLOT(BBSAVE(1),NX,NY,1)
C ***********************************
END IF
C
C
DO 40 I = 1,NXY
BBINT(I) = BBSAVE(I)
40 CONTINUE
C
C
END
C
INTEGER FUNCTION INTPXL(IPIXEL)
C ===============================
C
C
C---- Extract pixel value from raw pixel ipixel
C
C IPIXEL is integer*2, signed or unsigned
C
C Returns INTPXL = full value
c
IMPLICIT NONE
C
INTEGER*2 IPIXEL
C
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
INTEGER IBA
C
IBA = IPIXEL
IF (IBA.LT.0) THEN
IF ((MACHINE.EQ.'MAR ').OR.(MACHINE.EQ.'FUJI')) THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'RAXI') THEN
C
C---- Rigaku R-AXIS
C
IF (MODEL.EQ.'RAXIS ') THEN
IBA = (32768+IBA)*8
ELSE IF ((MODEL.EQ.'RAXISIV').OR.(MODEL.EQ.'RAXISV')) THEN
IBA = (32768+IBA)*32
ELSE
WRITE(IOUT,FMT=6010) MODEL
IF (ONLINE) WRITE(ITOUT,FMT=6010) MODEL
6010 FORMAT(1X,'***** unknown model for RAXIS scanners:',A)
STOP
END IF
ELSE IF (MACHINE.EQ.'MD') THEN
IBA = IBA + 65536
ELSE IF (MACHINE.EQ.'DIP2') THEN
CHRP for Atsushi Nakagawa IF (MODEL.EQ.'12BIT') THEN
CHRP for Atsushi Nakagawa IBA = -(IBA+1)*256 + 32768
IF (MODEL.EQ.'16BIT') THEN
IBA = -(IBA+1)*32
ELSE IF (MODEL.EQ.'12BIT') THEN
IBA = -(IBA+1)*256 + 32768
ELSE IF(MODEL.EQ.'16BITD') THEN
IBA = -(IBA+1)*32
ELSE
CHRP for Atsushi Nakagawa IBA = -(IBA+1)*32
IBA = IBA+65536
END IF
ELSE IF (MACHINE.EQ.'CCD1') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'CCD2') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'LMB') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'ADSC') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'SBC1') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'MARC') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'LIPS') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'CBF ')THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'JUPI') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'BRUK') THEN
IBA = -IBA*8
C
C---- "UNKNOWN" scanner type, stored as -I/8
C
ELSE IF (MACHINE.EQ.'UNK') THEN
IBA = -IBA*8
ELSE
C
C---- Put decoding for new scanner types here, MACHINE is assigned using
C SCANNER TYPE keywords
C
END IF
END IF
INTPXL = IBA
RETURN
END
C
INTEGER FUNCTION INTPXL2(IPIXEL)
C ===============================
C
C---- Extract pixel value from raw pixel ipixel
C
C IPIXEL is integer*2, signed or unsigned
C
C Returns INTPXL2 = full value
C Differs from INTPXL in that it applies a non-linearity correction
C if required
C
C
IMPLICIT NONE
C
INTEGER*2 IPIXEL
C
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C
INTEGER IBA
C
IBA = IPIXEL
IF (IBA.LT.0) THEN
IF ((MACHINE.EQ.'MAR ').OR.(MACHINE.EQ.'FUJI')) THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'RAXI') THEN
C
C---- Rigaku R-AXIS
C
IF (MODEL.EQ.'RAXIS ') THEN
IBA = (32768+IBA)*8
ELSE IF ((MODEL.EQ.'RAXISIV').OR.(MODEL.EQ.'RAXISV')) THEN
IBA = (32768+IBA)*32
ELSE
WRITE(IOUT,FMT=6010) MODEL
IF (ONLINE) WRITE(ITOUT,FMT=6010) MODEL
6010 FORMAT(1X,'***** unknown model for RAXIS scanners:',A)
STOP
END IF
ELSE IF (MACHINE.EQ.'MD') THEN
IBA = IBA + 65536
ELSE IF (MACHINE.EQ.'DIP2') THEN
IF (MODEL.EQ.'12BIT') THEN
IBA = -(IBA+1)*256 + 32768
ELSE
IBA = -(IBA+1)*32
END IF
ELSE IF (MACHINE.EQ.'CCD1') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'CCD2') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'LMB') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'ADSC') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'SBC1') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'MARC') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'LIPS') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'JUPI') THEN
IBA = -IBA*8
ELSE IF (MACHINE.EQ.'BRUK') THEN
IBA = -IBA*8
C
C---- "UNKNOWN" scanner type, stored as -I/8
C
ELSE IF (MACHINE.EQ.'UNK') THEN
IBA = -IBA*8
ELSE
C
C---- Put decoding for new scanner types here, MACHINE is assigned using
C SCANNER TYPE keywords
C
END IF
END IF
C
IF (CURV.EQ.0) THEN
INTPXL2 = IBA
ELSE
INTPXL2 = NINT(IBA+CURV*IBA*IBA)
END IF
RETURN
END
C== INVNOR ==
C
C
SUBROUTINE INVNOR(Q,NNP,QINV)
C ===================================
IMPLICIT NONE
C
C---- INVERTS a normal matrix Q of size NNP*NNP which *must* be supplied as a
C one-dimensional REAL array Q(NNP*NNP), not as 2D Q(NNP,NNP). Uses the
C Harwell routines for determining eigenvalues and eigenvectors.
C
C INPUT arguments - Q, NNP
C
C OUTPUT DOUBLE PRECISION QINV
C
C Note well - Determinant is not calculated - we rely on eigenvalue
C filtering to work around singular matrices
C
C This subroutine DEBUG(40) i.e. keywords DEBUG REFRT1
C
C ..
C .. Scalar arguments
INTEGER NNP
REAL Q(NNP*NNP)
DOUBLE PRECISION QINV(NNP*NNP)
C ..
C .. Local Scalars ..
INTEGER I,J,IJ,K,NFILT,NNQ,NNPSQ
PARAMETER(NNQ = 100)
C ..
C .. Local Arrays ..
DOUBLE PRECISION QVD(NNQ,NNQ),WORK(NNQ,NNQ),
$ EIGVAL(NNQ),
$ WV(5*NNQ),
$ EIGMAT(NNQ,NNQ),
$ EIGVALI(NNQ),TOL
C ..
C .. External Subroutines ..
EXTERNAL EA06CD
C ..
C .. include files ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
IF(DEBUG(40))THEN
IF(ONLINE)WRITE(ITOUT,FMT=6000)NNP
WRITE(IOUT,FMT=6000)NNP
ENDIF
NNPSQ = NNP*NNP
TOL = 1.0D-6
C
C---- initialize all locally modified arrays
C
DO 80 I = 1,NNPSQ
QINV(I) = 0.0
80 ENDDO
DO 90 I = 1,NNQ
EIGVAL(I) = 0.0
EIGVALI(I) = 0.0
DO 85 J = 1,NNQ
IF(J.LE.5)WV(((J-1)*5)+I) = 0.0
QVD(I,J) = 0.0
WORK(I,J) = 0.0
EIGMAT(I,J) = 0.0
85 ENDDO
90 ENDDO
C
C---- stick Q into vectors QVD so it's treated properly by EA06CD and MINV
C
if(debug(40))then
write(iout,fmt=6080)Q
if(online)write(itout,fmt=6080)Q
endif
DO 110 I = 1,NNP
DO 105 J=1,NNP
QVD(I,J)=Q((I-1)*NNP+J)
105 ENDDO
110 ENDDO
C
C---- find eigenvalues and eigenvectors
C
CALL EA06CD(QVD,EIGVAL,EIGMAT,NNQ,NNQ,NNQ,WV)
NFILT = 0
IF(DEBUG(40)) THEN
WRITE(IOUT,6050)(EIGVAL(I),I=1,NNP),
$ ((EIGMAT(I,J),I=1,NNP),J=1,NNP)
IF(ONLINE)WRITE(ITOUT,6050)(EIGVAL(I),I=1,NNP),
$ ((EIGMAT(I,J),I=1,NNP),J=1,NNP)
ENDIF
C
C----
C
DO 300 I = 1,NNP
IF (EIGVAL(I).GT.TOL) THEN
EIGVALI(I) = 1.0D0/EIGVAL(I)
ELSE
NFILT = NFILT + 1
EIGVALI(I) = 0.0D0
END IF
300 CONTINUE
C
C----
C
IF (DEBUG(40).and.(nfilt.gt.0)) THEN
WRITE(IOUT,FMT=6040) NFILT
IF (ONLINE) WRITE(ITOUT,FMT=6040) NFILT
END IF
C
C---- Form (eigenval)-1 * tr(eigenvec)
C
DO 310 I = 1,NNP
DO 320 J = 1,NNP
WORK(I,J) = EIGMAT(J,I)*EIGVALI(I)
320 CONTINUE
310 CONTINUE
C
C---- Form (eigenvec) * (eigenval)-1 * tr(eigenvec)
C
IJ = 0
DO 330 I = 1,NNP
DO 340 J = 1,NNP
IJ = IJ + 1
QINV(IJ) = 0.0
DO 350 K = 1,NNP
QINV(IJ) = QINV(IJ) + EIGMAT(I,K)*WORK(K,J)
350 CONTINUE
340 CONTINUE
330 CONTINUE
IF (DEBUG(40)) THEN
WRITE(IOUT,FMT=6070)(QINV(IJ),IJ=1,NNP*NNP)
IF (ONLINE) WRITE(ITOUT,FMT=6070)
$ (QINV(IJ),IJ=1,NNP*NNP)
ENDIF
RETURN
C
C---- FORMAT STATEMENTS
C
6000 FORMAT(/,'INVERTING NORMAL MATRIX WITH NEW ROUTINES',/,
$ 'NNP (dimension of array edge) is ',I3)
6010 FORMAT(/,'Initialising EIGVEC and QINV')
6020 FORMAT(/,'Initialising EIGVALI, QVD, WORK, EIGMAT')
6030 FORMAT(/,'Sticking Q values into QVD')
6040 FORMAT(/,'Number of eigenvalues filtered = ',I3)
6050 FORMAT(/,/,1X,'Eigenvalues',/,1X,8E10.3,/,
+ ' Eigenvectors',/,8(1X,8E10.3,/))
6060 FORMAT(72('*'),/,26X,'Eigenvalue filter on',26X,/,72('*'),//)
6070 FORMAT(//,' Inverse Normal Matrix',/,8(1X,8E10.3,/))
6080 FORMAT(//,' Starting Normal Matrix',/,8(1X,8E10.3,/))
c 6050 FORMAT(/,/,1X,'Eigenvalues',/,1X,8(E10.3,1X),/,
c + ' Eigenvectors',/,8(1X,8(E10.3,1X),/))
c 6070 FORMAT(//,' Inverse Normal Matrix',/,8(1X,12(E10.3,1X),/))
c 6080 FORMAT(//,' Starting Normal Matrix',/,8(1X,12(E10.3,1X)/))
END
C== JSWTCH ==
C
C
C
SUBROUTINE JSWTCH(I1,I2)
C ========================
C
C
C
C
C
C .. Scalar Arguments ..
INTEGER I1,I2
C ..
C .. Local Scalars ..
INTEGER IDUM
C ..
C
C
IDUM = I1
I1 = I2
I2 = IDUM
C
C
END
SUBROUTINE KILLSPT(NSPTD,IXP,IYP)
C
C---- Find spot (from spots list) at display pixel coordinates IXP,IYP
C and negate its intensity (effectively rejecting it)
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER NSPTD,IXP,IYP
C ..
C .. Array Arguments ..
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER I,INDEX,N,ISIZE
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
EXTERNAL DSPXCRS
C ..
C .. Extrinsic Functions ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C---- Find reflection nearest the given display pixel coords
C
ISIZE = 5
IF (NZOOM.GT.0) ISIZE = 8
DO 10 I = 1,NSPTD
IF (ABS(IXP-IXSPT(I)).GT.4) GOTO 10
IF (ABS(IYP-IYSPT(I)).GT.4) GOTO 10
INDEX = INDX(I)
CAL WRITE(6,*),'I,Index',I,INDEX
CALL DSPXCRS(IXSPT(I),IYSPT(I),1,1,ISIZE)
IF ((INDEX.GT.0).AND.(INDEX.LE.NSPOTS))
+ ISPT(INDEX) = - ISPT(INDEX)
RETURN
10 CONTINUE
END
C
SUBROUTINE LAUEPHI(NLAUE,IROTAX,PHILAUE,PHIPAD)
C ==============================================
C
IMPLICIT NONE
C
C---- Determine the rotation range required to generate all the unique
C daat fro this Laue group and crystal orientation
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
INTEGER NLAUE,IROTAX
REAL PHILAUE,PHIPAD
C
C ..
C .. Local Scalars ..
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
C---- LAUE = 3, 1bar, hkl:l>=0 hk0:h>=0 0k0:k>=0
C
IF (NLAUE.EQ.3) THEN
PHILAUE = 180.0
C
C---- LAUE = 4, 2/m, hkl:k>=0, l>=0 hk0:h>=0
C
ELSE IF (NLAUE.EQ.4) THEN
IF (IROTAX.EQ.2) THEN
PHILAUE = 180.0
ELSE
PHILAUE = 90.0
PHIPAD = 90.0
END IF
C
C---- LAUE = 6, mmm, hkl:h>=0, k>=0, l>=0
C
ELSE IF (NLAUE.EQ.6) THEN
PHILAUE = 90.0
C
C---- LAUE = 7, 4/m, hkl:h>=0, k>0, l>=0 with k>=0 for h=0
C
ELSE IF (NLAUE.EQ.7) THEN
PHILAUE = 90.0
C
C---- LAUE = 8, 4/mmm, hkl:h>=0, h>=k>=0, l>=0
C
ELSE IF (NLAUE.EQ.8) THEN
IF (IROTAX.EQ.3) THEN
PHILAUE = 45.0
PHIPAD = 45.0
ELSE
PHILAUE = 90.0
END IF
C
C---- LAUE = 9, 3bar, hkl:h>=0, k>0 including 00l:l>0
C
ELSE IF (NLAUE.EQ.9) THEN
IF (IROTAX.EQ.3) THEN
PHILAUE = 120.0
ELSE
PHILAUE = 90.0
PHIPAD = 30.0
END IF
C
C---- LAUE = 10, 312, hkl:h>=0, k>=0 with k<=h and l>=0 if h = 0
C
ELSE IF (NLAUE.EQ.10) THEN
IF (IROTAX.EQ.3) THEN
PHILAUE = 60.0
ELSE
PHILAUE = 90.0
END IF
C
C---- LAUE = 11, 321, hkl:h>=0, k>=0 with k<=h and l>=0 if h = k
C
ELSE IF (NLAUE.EQ.11) THEN
IF (IROTAX.EQ.3) THEN
PHILAUE = 60.0
ELSE
PHILAUE = 90.0
END IF
C
C---- LAUE = 12, 6/m, hkl:h>=0, k>0, l>=0 with k>=0 for h=0
C
ELSE IF (NLAUE.EQ.12) THEN
IF (IROTAX.EQ.3) THEN
PHILAUE = 60.0
ELSE
PHILAUE = 90.0
END IF
C
C---- LAUE = 13, 6/mmm, hkl:h>=0, h>=k>=0, l>=0
C
ELSE IF (NLAUE.EQ.13) THEN
IF (IROTAX.EQ.3) THEN
PHILAUE = 30.0
ELSE
PHILAUE = 90.0
END IF
C
C---- LAUE = 14, m3, hkl:h>=0, k>=0, l>=0 with l>=h, k>=h for l=h
C and k>h for l>h
C
ELSE IF (NLAUE.EQ.14) THEN
PHILAUE = 45
C
C---- LAUE = 15, m3m, hkl:k>=l>=h>=0
C
ELSE IF (NLAUE.EQ.15) THEN
PHILAUE = 45
ELSE
C
C
10 WRITE (IOUT,FMT=6010) NLAUE
IF (ONLINE) WRITE (ITOUT,FMT=6010) NLAUE
6010 FORMAT (//1X,'**** WRONG LAUE GROUP = ',I6,' ****',/)
STOP
END IF
C
END
C
C== LIMITS ==
C
C
C
SUBROUTINE LIMITS(IER,LB,LE,LMIN,LMAX)
C ======================================
C
C
C
C---- Checks whether index is outside limit.
C
C If IER = 0, Limits are ok
C If IER .NE. 0, Limits are bad
C
C
C
C
C .. Scalar Arguments ..
INTEGER IER,LB,LE,LMAX,LMIN
C ..
C .. Intrinsic Functions ..
INTRINSIC MAX,MIN
C ..
C
C
IER = 0
C
C
IF (LB.GT.LMAX .OR. LE.LT.LMIN) THEN
IER = 1
ELSE
LB = MAX(LB,LMIN)
LE = MIN(LE,LMAX)
END IF
C
C
RETURN
C
C
END
c load_image.f
c maintained by G.Winter
c 9th May 2002
c
c This is a subroutine to load an image into memory when all other methods
c apear to have failed - ie the use of the `image' keyword is prohibited
c as you have done some processing....
c
c
c
c
c
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
subroutine load_image(argc, argv, types, values)
implicit none
c specification:
c
c 1. Interpret the command line - ideally this should be just load_image
c and the image number to load. Make this mandatory. Something to do
c with phi?
c 2. Return, happy.
c
c Fairly standard header stuff...
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/gui.f
c gui.h
c maintained by G.Winter
c 16th April 2002
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c This defines the variables and common blocks which are used by the
c new gui control routine. This will also be used in xdisp and control,
c to switch the new gui on!
c
c
logical gui_switch
integer nargs
parameter (nargs = 200)
common /gui/ gui_switch
C&&*&& end_include ../inc/gui.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
integer lenstr
external lenstr, load_image_help
integer argc, types(nargs)
character*80 argv(nargs), word, secondword
character*1000 outline
real values(nargs)
c locally used things
integer image_number, nfirsti, modeop, ipack
CHRP - need to declare ID,NDIRSTI
INTEGER ID,NDIRSTI
logical pack, forceread
C HRP - avoid compilation warning by initializing ID, but I'll bet
C this breaks this routine - still, users won't notice yet...
DATA ID / -999 /
c required format statements
1 format('',
$ 'ok')
2 format('',
$ 'errorImage not found')
c determine the input value
if(argc .eq. 1) then
if(.not. socklo) then
write(*, *) 'This needs an image number'
else
write(outline, 2)
call write_socket_length(serverfd, lenstr(outline),
$ outline)
end if
return
end if
word = argv(2)
call ccplwc(word)
if(word .eq. 'help') then
call load_image_help
return
end if
if(types(2) .eq. 2) then
image_number = nint(values(2))
else
if(.not. socklo) then
write(*,*) argv(2), ' should be an integer'
else
write(outline, 2)
call write_socket_length(serverfd, lenstr(outline),
$ outline)
end if
return
end if
c set things up for image reading
modeop = 1
nfirsti = 1
ipack = 0
forceread = .true.
call openods(waxfn, image_number, ndirsti, odext, fdisk,
$ modeop, pack, odfile, sepchar, forceread, ipack,
$ templstart, templend)
c catch errors
if(id .le. -999) then
if(.not. socklo) then
write(*, *) 'Failed to open the image'
else
write(outline, 2)
call write_socket_length(serverfd, lenstr(outline),
$ outline)
end if
return
end if
if(socklo) then
write(outline, 1)
call write_socket_length(serverfd, lenstr(outline),
$ outline)
end if
return
end
subroutine load_image_help
c some help information for the load_image function
write(*, *) 'load_image help:'
write(*, *) 'this will just want an image number to load'
return
end
C== LOOPST ==
C
C
C
SUBROUTINE LOOPST(NLOOP,Q1,Q2,R1,R2)
C ====================================
C
C************ CHANGE THIS FOR PATTERN MATCHING ***********
C
C
C
C
C .. Scalar Arguments ..
REAL Q1,Q2,R1,R2
INTEGER NLOOP
C ..
C .. Local Scalars ..
REAL A
C ..
C .. Intrinsic Functions ..
INTRINSIC INT
C ..
C .. Common blocks ..
C&&*&& include ../inc/loop.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file loop.h
C---- START of include file loop.h
C
C
C .. Scalars in Common Block /LOOP/ ..
INTEGER IRLB,IRLE
C ..
C .. Common Block /LOOP/ ..
COMMON /LOOP/IRLB(2),IRLE(2)
C ..
C
C
C&&*&& end_include ../inc/loop.f
C ..
SAVE
C .. Statement Functions ..
INTEGER INTB,INTE
C ..
C .. Statement Function definitions ..
C
INTB(A) = INT(A-3.0)
INTE(A) = INT(A+3.0)
C ..
C
C
IRLB(1) = INTB(Q1)
IRLE(1) = INTE(Q2)
C
C
IF (NLOOP.GT.1) THEN
IRLB(2) = INTB(R1)
IRLE(2) = INTE(R2)
END IF
C
C
RETURN
C
C
END
C== LPCOR ==
C
SUBROUTINE LPCOR(XH,CS2TH,FLP,IFLAG)
C ===================================+
C
C XH(3) Rlp coordinates
C CS2TH Cos(theta)**2
C FLP Lp factor (returned)
C IFLAG Returned as non-zero in case of error
C
IMPLICIT NONE
C
C
C---- cos 2theta FOR GRAPHITE MONOCHROMATOR CRYSTAL = 26 DEGREES
C
C .. Scalar Arguments ..
REAL CS2TH,FLP
INTEGER IFLAG
C ..
C .. Array Arguments ..
REAL XH(3)
C ..
C .. Local Scalars ..
REAL CC2TH,COS2RO,COSRO,FPOL,LORINV,SS2TH,
+ YPROJ,ZETA,ZETASQ
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C ..
C .. Data statements ..
C ..
C
C---- For SRS corrections see
C Kahn et al. j. appl. cryst. (1982) 15, 330.
C
C---- Values of tor for srs sources
C LURE 1.4A TOR = 0.89
C D/L Ge(111),1.488A
C With Mirror 2GeV TOR = 0.86
C
ZETA = XH(3)
CC2TH = CS2TH*CS2TH
SS2TH = 1.0 - CC2TH
ZETASQ = ZETA*ZETA
COSRO = ZETA/SQRT(SS2TH)
COS2RO = 2.0*COSRO*COSRO - 1.0
C
C---- Lorentz factor (L**-1)
C
YPROJ = SS2TH - ZETASQ
IF (YPROJ.LE.0.0) THEN
IFLAG = 1
ELSE
LORINV = SQRT(YPROJ)
C
C---- Refer to Arndt & Wonacott book page 86
C for use of test factor 0.02.
C
IF (LORINV/SQRT(SS2TH).LT.0.02) THEN
WRITE (6,FMT=9010)
9010 FORMAT (' WARNING - Reflection too near AXIS ')
IFLAG = 1
RETURN
END IF
C
C---- Standard polarisation correction
C
FPOL = (1.0+CC2TH)*0.5 - 0.5*TOR*SS2TH*COS2RO
C
C---- Reciprocal of LP factor calculated here as FLP
C
FLP = LORINV/FPOL
END IF
C
C
END
C
C== MASKIT ==
SUBROUTINE MASKIT(MODE,MASK,IOPTRAS,AVERAGE,MASKREJ,MASKREJP,
+ PQSUMS,PQSUMINV)
IMPLICIT NONE
C
C---- This subroutine checks for overlapping spots using the sorted (on
C scanner X coordinate) list of spots from GENSORT and the spot
C sizes set up by RMAXR if MODE=1 or using the optimised raster
C parameters if MODE=2. It finds all peak and background pixels
C which are overlappe dby the peak region of a neighbouring
C reflection, for each of the standard profile areas on the image.
C The list of rejected pixels is stored in MASKREJ so that these are
C not used when forming the weighted profiles or in integration. It
C sets up the background sums in PQSUMS and the inverse matrices in
C PQSUMINV for background plane determination allowing for the
C rejected pixels.
C
C Rejected PEAK pixels are kept in a separate array MASKREJP
C
C
C MODE = 1 Use box sizes calculated by RMAXR rather than the optimised
C parameters.
C = 2 Use previously determined optimised box parameters (Except
C for profiles to be averaged), but call GENSORT as this
C is the first call to MASKIT for this image
C = 3 Use the optimised box parameters (Except for profiles to be
C averaged), but do not call GENSORT as this is the second call
C for this image
C
C MASK is passed in but is used as a working array here to set up
C the peak/background masks for each stripe. This subroutine does
C NOT return values in MASK which are used elsewhere in the
C program.
C
C IOPTRAS contains the optimised box parameters (corner, X and Y rims)
C which are used when MODE=2 or 3 (except for profiles to be averaged).
C
C AVERAGE is TRUE for standard profiles whioh are to be averaged. The
C optimised raster parameters will NOT be used for these
C profiles as they may not be reliable.
C
C MASKREJ Contains list of background pixels that are overlapped
C by peaks of neighbouring spots, so these can be rejected
C during profile fitting.
C
C
C MASKREJP Contains list of peak pixels that are overlapped
C by peaks of neighbouring spots, so these can be rejected
C during profile fitting.
C
C Elements of PQSUMS
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY.
C
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C DEBUG(44) for this S/R.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE
C ..
C .. Array Arguments ..
INTEGER IOPTRAS(3,NMASKS),MASK(MAXBOX,1:NNLINE-1),
+ MASKREJ(NREJMAX,NMASKS),MASKREJP(NREJMAX,NMASKS)
REAL PQSUMS(6,NMASKS),PQSUMINV(9,NMASKS)
LOGICAL AVERAGE(NMASKS)
C ..
C .. Local Scalars ..
INTEGER I,J,K,IJ,NXX,NYY,NHX,NHY,NXB,NYB,NXYB,NY,NYYS,NPBOX,NBOX,
+ IX1,IX2,IY1,IY2,ISTRIP,ISTRIPCUR,NREJ,NFBOX,NEXTI,
+ MINX,MINY,IDX,IDY,ISEPX,ISEPY,NRX,NRY,NC,IOFFSET,P,Q,
+ IDR,JBOX,NREJP,NXYB2,IFLAG,NSEP,JSEP,
+ IHX,IHY,LLIMIT,NTOT,IXP1,IYP1,IXP2,IYP2,MODEGEN
REAL S,SP,SQ,SPQ,SPP,SQQ,LVLIM,LPTMIN
LOGICAL LFORCE,LADDPART,LLAST
C ..
C .. Local Arrays ..
INTEGER JRAS(5),LRAS(5),LPROFL(MAXBOX),IWPK(3)
INTEGER*2 LMASK(MAXBOX,NNLINE-1)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL GENSORT,GETSTRIP,GETYIND,GETBOX,PQINV,SETMASK,RASPLOT4,
+ SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
C
INTEGER IDXSTORE,IDYSTORE,NUMB,NSTORE
COMMON /SEPAR/ IDXSTORE(200,NMASKS),IDYSTORE(200,NMASKS),
+ NUMB(200,NMASKS),NSTORE(NMASKS)
C ..
C .. Equivalences ..
EQUIVALENCE (LRAS(1),NXX), (LRAS(2),NYY), (LRAS(3),NC),
+ (LRAS(4),NRX), (LRAS(5),NRY)
C
SAVE
C
C---- First generate a list of all possible reflections on the current
C image, excluding only spots flagged as overlapping
C
MODEGEN = -1
LFORCE = .FALSE.
LLIMIT = 0
LVLIM = 0.0
LPTMIN = 0.0
LADDPART = .FALSE.
LLAST = .FALSE.
IF (MODE.NE.3)
+ CALL GENSORT(MODEGEN,LFORCE,LLIMIT,LVLIM,NTOT,LADDPART,
+ LPTMIN,LLAST)
C
C
IDR = 1
C
DO 2 I = 3,5
C
C---- Reduce the peak size by 2*ITRIM pixels to minimise overlap
C
LRAS(I) = IRAS(I) + ITRIM
JRAS(I) = IRAS(I)
2 CONTINUE
C
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6000) MODE,NTOT,IRAS,ITRIM,NOVERLAP
IF (ONLINE) WRITE(ITOUT,FMT=6000) MODE,NTOT,IRAS,ITRIM,NOVERLAP
6000 FORMAT(//1X,'MASKIT mode',I2,/,1X,'Number of reflections from',
+ ' GENSORT:',I5,/,1X,'Non-optimised raster parameters ',
+ '(IRAS) are',5I4, ' ITRIM=',I3,' NOVERLAP=',I3)
END IF
ISTRIPCUR = 0
C
DO 3 J = 1,NMASKS
NSTORE(J) = 0
DO 4 IJ = 1,200
NUMB(IJ,J) = 1
4 CONTINUE
3 CONTINUE
C
C
DO 40 I = 1,NTOT
C
IX1 = IX(I)
IY1 = IY(I)
C
C---- Convert 10 micron units to pixels
C
IXP1 = NINT(IX1*FACT)
IYP1 = NINT(IY1*FACT)
C
C---- Get box number and strip number
C
CALL GETBOX(IXP1,IYP1,NXX,NYY,NPBOX)
CALL GETSTRIP(NPBOX,ISTRIP)
CALL GETYIND(NPBOX,NY)
NHX = NXX/2
NHY = NYY/2
NYYS = NYY
C
C---- If optimised box parameters are available, use them
C
IF (MODE.NE.1) THEN
IF (AVERAGE(NPBOX)) THEN
NC = IRAS(3)
NRX = IRAS(4)
NRY = IRAS(5)
ELSE
NC = IOPTRAS(1,NPBOX)
NRX = IOPTRAS(2,NPBOX)
NRY = IOPTRAS(3,NPBOX)
END IF
END IF
C
C---- Is this a new strip, if so, deal with previous strip
C
IF (ISTRIP.NE.ISTRIPCUR) THEN
IF (ISTRIPCUR.EQ.0) GOTO 14
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6002) ISTRIPCUR
IF (ONLINE) WRITE(ITOUT,FMT=6002) ISTRIPCUR
6002 FORMAT(//1X,'Dealing with strip',I3)
DO 5 J = 1,NYLINE-1
NBOX = IBOX(ISTRIPCUR,J)
IF ((NBOX.LE.0).OR.(.NOT.BOX(NBOX))) GOTO 5
NSEP = NSTORE(NBOX)
WRITE(IOUT,FMT=6006) J,NBOX,NSEP,(IDXSTORE(JSEP,NBOX),
+ IDYSTORE(JSEP,NBOX),NUMB(JSEP,NBOX),JSEP=1,NSEP)
IF (ONLINE) WRITE(ITOUT,FMT=6006) J,NBOX,NSEP,
+ (IDXSTORE(JSEP,NBOX),
+ IDYSTORE(JSEP,NBOX),NUMB(JSEP,NBOX),JSEP=1,NSEP)
6006 FORMAT(/1X,'For Y-index',I3,' Box number',I3,
+ ' there are',I3,' different',
+ ' separations as below',/,1X,' IDX IDY Number',/,
+ (1X,2I5,I7))
5 CONTINUE
END IF
C
C---- Loop over boxes in this stripe and use array LMASK to set up
C the list of rejected points in MASKREJ.
C
DO 12 J = 1,NYLINE-1
NBOX = IBOX(ISTRIPCUR,J)
C
C---- First check if this is a real box (virtual boxes, used in variable
C profiles, have negative box numbers)
C
IF (NBOX.LE.0) GOTO 12
C
C---- Now check that this is a valid area. Some definitions of boundary
C lines will give areas completely outside the detector boundary.
C
IF (.NOT.BOX(NBOX)) GO TO 12
C
C---- Set up size of this box
C
NXB = ISIZE(NBOX,1)
NYB = ISIZE(NBOX,2)
C
C
NXYB = NXB*NYB
C
C---- Now symmetrise LMASK (only have half the possible overlaps from
C the search because only consider spots with greater X coordinate
C than reference spot.
C
NXYB2 = NXYB/2
DO 6 K=1,NXYB2
IFLAG = 1
IF ((LMASK(K,J).EQ.0).OR.(LMASK(NXYB-K+1,J).EQ.0)) IFLAG=0
LMASK(K,J) = IFLAG
LMASK(NXYB-K+1,J) = IFLAG
6 CONTINUE
C
C---- Now set up MASKREJ using LMASK.
C Use optimised raster box parameters if available.
C
JRAS(1) = NXB
JRAS(2) = NYB
IF (MODE.NE.1) THEN
IF (AVERAGE(NBOX)) THEN
JRAS(3) = IRAS(3)
JRAS(4) = IRAS(4)
JRAS(5) = IRAS(5)
ELSE
JRAS(3) = IOPTRAS(1,NBOX)
JRAS(4) = IOPTRAS(2,NBOX)
JRAS(5) = IOPTRAS(3,NBOX)
END IF
END IF
C ***********************
CALL SETMASK(MASK(1,J),JRAS)
C ***********************
NREJ = 1
NREJP = 1
DO 7 K = 1,NXYB
IF (LMASK(K,J).EQ.0) THEN
C
C---- *** IMPORTANT *** ONLY include rejected BACKGROUND pixels in MASKREJ
C
IF (MASK(K,J).EQ.-1) THEN
NREJ = NREJ + 1
C
C---- Trap more than NREJMAX rejected background pixels
C
IF (NREJ.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
6008 FORMAT(//1X,'****** FATAL ERROR ******',/,
+ 1X,'More than ',I5,
+ ' Background pixels rejected due to overlap of ',
+ 'neighbouring',/,1X,'spots. Check that the minimum ',
+ 'allowed spot separation (SEPARATION keyword)',/,1X,'is ',
+ 'appropriate for this image...problems will arise if',
+ ' these values are',/,1X,'too small',/,1X,'If this is not',
+ ' the problem, try to reduce the overall size of the',/,1X,
+ 'measurement box. If profile optimisation is being used',
+ ' (this is the default)',/,1X,'then PROFILE RATIO keywords'
+ ,' determine how large the overall box will be.',/,1X,
+ 'Reduce RATIO to get a smaller box, or alternatively use',
+ ' PROFILE FIXBOX',/,1X,'keywords to prevent optimisation',
+ ' of the overall dimensions of the box.',
+ /,1X,'If this is not a',
+ ' viable option, change parameter NREJMAX to a larger ',
+ /,1X,'and recompile the program')
MASKREJ(NREJ,NBOX) = K
ELSE IF (MASK(K,J).EQ.1) THEN
NREJP = NREJP + 1
C
C---- Trap more than NREJMAX rejected peak pixels
C
IF (NREJP.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
MASKREJP(NREJP,NBOX) = K
END IF
END IF
7 CONTINUE
MASKREJ(1,NBOX) = NREJ - 1
MASKREJP(1,NBOX) = NREJP - 1
NREJP = NREJP - 1
C
C---- Set WARNing flag if there are overlapped peak pixels
C
IF ((.NOT.WARN(1)).AND.NREJP.GT.0.AND.MODE.EQ.3)
+ WARN(1) = .TRUE.
C
C---- Now set up PQSUMS and PQSUMINV for boxes in this strip
C
IHX = NXB/2
IHY = NYB/2
IJ = 0
SP = 0.0
SQ = 0.0
SPQ = 0.0
SPP = 0.0
SQQ = 0.0
S = 0.0
DO 8 P = -IHX,IHX
DO 9 Q = -IHY,IHY
IJ = IJ + 1
IF ((MASK(IJ,J).EQ.-1).AND.(LMASK(IJ,J).EQ.1)) THEN
C
C Background pixels
C
S = S + 1
SP = P + SP
SQ = Q + SQ
SPP = P*P + SPP
SQQ = Q*Q + SQQ
SPQ = P*Q + SPQ
END IF
9 CONTINUE
8 CONTINUE
PQSUMS(1,NBOX) = SPP
PQSUMS(2,NBOX) = SQQ
PQSUMS(3,NBOX) = SPQ
PQSUMS(4,NBOX) = SP
PQSUMS(5,NBOX) = SQ
PQSUMS(6,NBOX) = S
C
C **************************************
CALL PQINV(PQSUMS(1,NBOX),PQSUMINV(1,NBOX))
C **************************************
C
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6004) NBOX,JRAS,MASKREJ(1,NBOX),NREJP,
+ (PQSUMS(K,NBOX),K=1,6),(PQSUMINV(K,NBOX),K=1,9)
IF (ONLINE) WRITE(ITOUT,FMT=6004)NBOX,JRAS,MASKREJ(1,NBOX),
+ NREJP,(PQSUMS(K,NBOX),K=1,6),(PQSUMINV(K,NBOX),
+ K=1,9)
6004 FORMAT(1X,'Box',I3,' Raster parameters',5I3,/,1X,
+ 'Number rejected background pixels',I4,
+ ' number rejected peak pixels',I4,/,1X,
+ 'PQSUMS',6F12.0,/,1X,'PQSUMINV',9F12.8)
END IF
12 CONTINUE
C
C---- Now set up the masks for the current strip
C
14 ISTRIPCUR = ISTRIP
NFBOX = NPFIRST(ISTRIP)
DO 18 J = 1,NYLINE-1
NYY = ISIZE(NFBOX,2)
IF (.NOT.BOX(NFBOX)) GOTO 17
C
C
C---- If optimised box parameters are available, use them
C---- Reduce the peak size by 2*ITRIM pixels to minimise overlap
C
C
IF (MODE.NE.1) THEN
IF (AVERAGE(NFBOX)) THEN
NC = IRAS(3) + ITRIM
NRX = IRAS(4) + ITRIM
NRY = IRAS(5) + ITRIM
ELSE
NC = IOPTRAS(1,NFBOX) + ITRIM
NRX = IOPTRAS(2,NFBOX) + ITRIM
NRY = IOPTRAS(3,NFBOX) + ITRIM
END IF
END IF
C ***********************
CALL SETMASK(MASK(1,J),LRAS)
C ***********************
C
17 NFBOX = NFBOX + 1
NXYB = NXX*NYY
C
C---- Initialise LMASK to 1 for all pixels. Overlapped pixels will be
C flagged with LMASK set to zero
C
DO 16 IJ = 1,NXYB
LMASK(IJ,J) = 1
16 CONTINUE
18 CONTINUE
C
C
NYY = NYYS
C
C---- End of dealing with new strip
C
END IF
C
C---- Get coordinates of next spot
C
NEXTI = I + 1
C
C---- Min separation: Peak of one box overlaps other box if
C separation l.e. min.
C
MINX = (2*NHX - NRX)
MINY = (2*NHY - NRY)
DO 30 J = NEXTI,NTOT
IX2 = IX(J)
IY2 = IY(J)
IDX = NINT((IX2 - IX1)*FACT)
IF (IDX.GT.MINX) GOTO 40
IDY = NINT((IY2 - IY1)*FACT)
IF (ABS(IDY).GT.MINY) GOTO 30
C
C---- Test if this separation has already been dealt with, since the
C separtion (in pixels) will be the same for many pairs of spots
C in the same area of the image.
C
NSEP = NSTORE(NPBOX)
DO 20 JSEP = 1,NSEP
IF ((IDX.EQ.IDXSTORE(JSEP,NPBOX)).AND.
+ (IDY.EQ.IDYSTORE(JSEP,NPBOX))) THEN
NUMB(JSEP,NPBOX) = NUMB(JSEP,NPBOX) + 1
GOTO 21
END IF
20 CONTINUE
C
C---- This is a new separation
C
NSTORE(NPBOX) = NSTORE(NPBOX) + 1
JSEP = NSTORE(NPBOX)
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6009) IDX,IDY,IREC(I),IREC(J)
IF (ONLINE) WRITE(ITOUT,FMT=6009) IDX,IDY,IREC(I),IREC(J)
END IF
6009 FORMAT(1X,'New separation with IDX=',I3,'IDY=',I3,' due to',
+ ' reflections with record numbers',I6,' and',I6)
IF (JSEP.GT.200) THEN
WRITE(IOUT,FMT=6010)
6010 FORMAT(//1X,'*** FATAL ERROR IN MASKIT ***',/,1X,'More than',
+ ' 200 different separations ',/,1X,'Try defining',
+ ' more standard profile areas using PROFILE XLINES,',
+ ' YLINES')
CALL SHUTDOWN
END IF
IDXSTORE(JSEP,NPBOX) = IDX
IDYSTORE(JSEP,NPBOX) = IDY
C
C---- Don't actually do rejection until at least NOVERLAP occurences of
C this separation have been found
C
21 IF (NUMB(JSEP,NPBOX).NE.NOVERLAP) GOTO 30
C
C---- Peak background overlap possible. Use MASK to determine actual
C overlapping pixels
C
ISEPX = NHX - NRX
ISEPY = NHY - NRY
IJ = 0
IOFFSET = IDX*NYY + IDY
DO 24 P = -NHX,NHX
C
C---- Test for overlap
C
IF ((IDX - P).GT.ISEPX) THEN
IJ = IJ + NYY
GOTO 24
END IF
DO 22 Q = -NHY,NHY
IJ = IJ + 1
IF ((IDY.GE.0).AND.((IDY - Q).GT.ISEPY)) GOTO 22
IF ((IDY.LE.0).AND.((IDY - Q).LT.-ISEPY)) GOTO 22
C
C---- Test if this pixel in spot "J" is peak, if so flag it by
C setting LMASK to zero.
C
IF (MASK(IJ - IOFFSET,NY).EQ.1) LMASK(IJ,NY) = 0
C IF ((IDY.LT.0).AND.(MASK(IJ - IOFFSET,NY).EQ.1))
C + WRITE(6,*),'reject pixel,p,q,IDX,IDY',P,Q,IJ,idx,idy
22 CONTINUE
24 CONTINUE
C
C---- End of loop over secondary reflections "J"
C
30 CONTINUE
C
C---- End of loop over primary reflections "I"
C
40 CONTINUE
C
C---- Need to deal with this last stripe of data
C
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6002) ISTRIPCUR
IF (ONLINE) WRITE(ITOUT,FMT=6002) ISTRIPCUR
DO 44 J = 1,NYLINE-1
NBOX = IBOX(ISTRIPCUR,J)
IF ((NBOX.LE.0).OR.(.NOT.BOX(NBOX))) GOTO 44
NSEP = NSTORE(NBOX)
WRITE(IOUT,FMT=6006) J,NBOX,NSEP,(IDXSTORE(JSEP,NBOX),
+ IDYSTORE(JSEP,NBOX),NUMB(JSEP,NBOX),JSEP=1,NSEP)
IF (ONLINE) WRITE(ITOUT,FMT=6006) J,NBOX,NSEP,
+ (IDXSTORE(JSEP,NBOX),
+ IDYSTORE(JSEP,NBOX),NUMB(JSEP,NBOX),JSEP=1,NSEP)
44 CONTINUE
END IF
C
DO 60 J = 1,NYLINE-1
NBOX = IBOX(ISTRIPCUR,J)
C
C---- First check if this is a real box (virtual boxes, used in variable
C profiles, have negative box numbers)
C
IF (NBOX.LE.0) GOTO 60
C
C---- Now check that this is a valid area. Some definitions of boundary
C lines will give areas completely outside the detector boundary.
C
IF (.NOT.BOX(NBOX)) GO TO 60
C
C---- Set up size of this box
C
NXB = ISIZE(NBOX,1)
NYB = ISIZE(NBOX,2)
C
C
NXYB = NXB*NYB
C
C
C---- Now symmetrise LMASK (only have half the possible overlaps from
C the search because only consider spots with greater X coordinate
C than reference spot.
C
NXYB2 = NXYB/2
DO 48 K=1,NXYB2
IFLAG = 1
IF ((LMASK(K,J).EQ.0).OR.(LMASK(NXYB-K+1,J).EQ.0)) IFLAG=0
LMASK(K,J) = IFLAG
LMASK(NXYB-K+1,J) = IFLAG
48 CONTINUE
C
C
C---- Now set up MASKREJ using LMASK.
C Use optimised raster box parameters if available.
C
JRAS(1) = NXB
JRAS(2) = NYB
IF (MODE.NE.1) THEN
IF (AVERAGE(NBOX)) THEN
JRAS(3) = IRAS(3)
JRAS(4) = IRAS(4)
JRAS(5) = IRAS(5)
ELSE
JRAS(3) = IOPTRAS(1,NBOX)
JRAS(4) = IOPTRAS(2,NBOX)
JRAS(5) = IOPTRAS(3,NBOX)
END IF
END IF
C ***********************
CALL SETMASK(MASK(1,J),JRAS)
C ***********************
NREJ = 1
NREJP = 1
DO 50 K = 1,NXYB
IF (LMASK(K,J).EQ.0) THEN
C
C---- *** IMPORTANT *** ONLY include rejected BACKGROUND pixels in MASKREJ
C
IF (MASK(K,J).EQ.-1) THEN
NREJ = NREJ + 1
C
C---- Trap more than NREJMAX rejected background pixels
C
IF (NREJ.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
MASKREJ(NREJ,NBOX) = K
ELSE IF (MASK(K,J).EQ.1) THEN
NREJP = NREJP + 1
C
C---- Trap more than NREJMAX rejected peak pixels
C
IF (NREJP.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
MASKREJP(NREJP,NBOX) = K
END IF
END IF
50 CONTINUE
MASKREJ(1,NBOX) = NREJ - 1
MASKREJP(1,NBOX) = NREJP - 1
NREJP = NREJP + 1
C
C---- Now set up PQSUMS and PQSUMINV for boxes in this strip
C
IHX = NXB/2
IHY = NYB/2
IJ = 0
SP = 0.0
SQ = 0.0
SPQ = 0.0
SPP = 0.0
SQQ = 0.0
S = 0.0
DO 54 P = -IHX,IHX
DO 52 Q = -IHY,IHY
IJ = IJ + 1
C
C---- NOTE: Only consider background pixels for these sums
C
IF ((MASK(IJ,J).EQ.-1).AND.(LMASK(IJ,J).EQ.1)) THEN
S = S + 1
SP = P + SP
SQ = Q + SQ
SPP = P*P + SPP
SQQ = Q*Q + SQQ
SPQ = P*Q + SPQ
END IF
52 CONTINUE
54 CONTINUE
PQSUMS(1,NBOX) = SPP
PQSUMS(2,NBOX) = SQQ
PQSUMS(3,NBOX) = SPQ
PQSUMS(4,NBOX) = SP
PQSUMS(5,NBOX) = SQ
PQSUMS(6,NBOX) = S
C
C **************************************
CALL PQINV(PQSUMS(1,NBOX),PQSUMINV(1,NBOX))
C **************************************
C
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6004) NBOX,JRAS,MASKREJ(1,NBOX),NREJP,
+ (PQSUMS(K,NBOX),K=1,6),(PQSUMINV(K,NBOX),K=1,9)
IF (ONLINE) WRITE(ITOUT,FMT=6004)NBOX,JRAS,MASKREJ(1,NBOX),
+ NREJP,(PQSUMS(K,NBOX),K=1,6),(PQSUMINV(K,NBOX),
+ K=1,9)
END IF
60 CONTINUE
C
C---- Print raster masks if required
C
IF (DEBUG(44)) THEN
C
C---- Reset LRAS 3-5 now excluding ITRIM
C
DO 70 I = 3,5
LRAS(I) = IRAS(I)
70 CONTINUE
C
DO 80 JBOX = 1,NUMBOX
IF (.NOT.BOX(JBOX)) GOTO 80
NXX = ISIZE(JBOX,1)
NYY = ISIZE(JBOX,2)
IF (MODE.NE.1) THEN
IF (AVERAGE(JBOX)) THEN
LRAS(3) = IRAS(3)
LRAS(4) = IRAS(4)
LRAS(5) = IRAS(5)
ELSE
LRAS(3) = IOPTRAS(1,JBOX)
LRAS(4) = IOPTRAS(2,JBOX)
LRAS(5) = IOPTRAS(3,JBOX)
END IF
END IF
WRITE(IOUT,FMT=6020) JBOX,LRAS,MASKREJ(1,JBOX),
+ MASKREJP(1,JBOX)
IF (ONLINE) WRITE(ITOUT,FMT=6020) JBOX,LRAS,MASKREJ(1,JBOX),
+ MASKREJP(1,JBOX)
6020 FORMAT(/,1X,'Raster for box',I3,' Raster parameters',5I3,/,
+ 1X,'Number of rejected background pixels',I4,/,1X,
+ 1X,'Number of rejected peak pixels',I4)
C
C ***********************
CALL SETMASK(MASK(1,1),LRAS)
C ***********************
C ******************************************
CALL RASPLOT4(LPROFL,NXX,NYY,MASK(1,1),
+ MASKREJ(1,JBOX),IDR)
C ******************************************
80 CONTINUE
END IF
RETURN
END
C== MASKONE ==
SUBROUTINE MASKONE(MODE,IXS,IYS,IRECS,LRAS,MASKREJ,MASKREJP,
+ PQSUMS,PQSUMINV,XDEBUG,OD)
IMPLICIT NONE
C
C---- This subroutine checks the spot with coords IXS,IYS for
C overlapping spots using the sorted (on scanner X coordinate) list
C of spots from GENSORT and written to file COORDS. It finds all
C peak and background pixels which are overlapped by the peak region
C of a neighbouring reflection. The list of rejected pixels is
C stored in MASKREJ so that these are not used when forming the
C weighted profiles or in integration. It sets up the background
C sums in PQSUMS and the inverse matrices in PQSUMINV for background
C plane determination allowing for the rejected pixels.
C
C Rejected PEAK pixels are kept in a separate array MASKREJP
C
C MODE =0 First call for current image. Initialise pointers and
C read coordinates of all spots for the current image
C from file COORDS.
C
C =1 Subsequent spots on same image
C
C
C MASKREJ Contains list of background pixels that are overlapped
C by peaks of neighbouring spots, so these can be rejected
C during profile fitting. (Returned)
C
C
C MASKREJP Contains list of peak pixels that are overlapped
C by peaks of neighbouring spots, so these can be rejected
C during profile fitting. (Returned)
C
C Elements of PQSUMS
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY.
C
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C DEBUG(44) for this S/R.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE,IXS,IYS,IRECS
LOGICAL XDEBUG
C ..
C .. Array Arguments ..
INTEGER LRAS(5),MASKREJ(NREJMAX),MASKREJP(NREJMAX)
REAL PQSUMS(6),PQSUMINV(9)
INTEGER OD(MAXBOX)
C ..
C .. Local Scalars ..
INTEGER I,J,K,IJ,NXX,NYY,NHX,NHY,NXB,NYB,NXYB,NY,NYYS,NPBOX,NBOX,
+ IX1,IX2,IY1,IY2,ISTRIP,ISTRIPCUR,NREJ,NFBOX,NEXTI,
+ MINX,MINY,IDX,IDY,ISEPX,ISEPY,NRX,NRY,NC,IOFFSET,P,Q,
+ IDR,JBOX,NREJP,NXYB2,IFLAG,NSEP,JSEP,JST,IS,KREC,IR,
+ LLIMIT,NTOT,IXP1,IYP1,IXP2,IYP2,ISTART,JSTART,NDBG,IXJST,
+ ITR,NSAVE,NREJS,MAXPIX
REAL S,SP,SQ,SPQ,SPP,SQQ,LVLIM,LPTMIN,TOTOD
LOGICAL FIRST
C ..
C .. Local Arrays ..
INTEGER LPROFL(MAXBOX),IWPK(3),KRAS(5),MASK(MAXBOX),
+ IHKL(7),SUMOD(20),IORDER(20),NPXBG(20)
INTEGER LMASK(MAXBOX),JMASK(MAXBOX)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL PQINV,SETMASK,RASPLOT4,SHUTDOWN,BGSUMS,MOVLAP,ODPLOT4
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
C
INTEGER IDXSTORE,IDYSTORE,NUMB,NSTORE
COMMON /SEPAR/ IDXSTORE(200,NMASKS),IDYSTORE(200,NMASKS),
+ NUMB(200,NMASKS),NSTORE(NMASKS)
chrp INTEGER IDXSTORE,IDYSTORE,NUMB,NSTORE
chrp COMMON /SEPAR/ IDXSTORE(200),IDYSTORE(200),
chrp + NUMB(200)
C ..
C .. Equivalences ..
INTEGER IOD
REAL SPQOD(3),SBGOD,SBGPOD,SBGQOD,ABC(3),SPKOD,A,B,C
EQUIVALENCE (SPQOD(1),SBGPOD), (SPQOD(2),SBGQOD), (SPQOD(3),SBGOD)
C ..
C .. Equivalences ..
EQUIVALENCE (KRAS(1),NXX), (KRAS(2),NYY), (KRAS(3),NC),
+ (KRAS(4),NRX), (KRAS(5),NRY)
C
SAVE
C
C---- If required, read coor list
C
IF (MODE.EQ.0) THEN
READ(ICOORD) NTOT
READ(ICOORD) (IX(I),IY(I),IREC(I),I=1,NTOT)
ISTART = 1
JSTART = 1
JST = 1
NDBG = 0
IF (DEBUG(44)) THEN
WRITE(IOUT,FMT=6000) MODE,NTOT,ITRIM,NOVERLAP
IF (ONLINE) WRITE(ITOUT,FMT=6000) MODE,NTOT,ITRIM,NOVERLAP
6000 FORMAT(//1X,'MASKONE mode',I2,/,1X,'Number of reflections from',
+ ' file COORD',I5,/,1X,'ITRIM=',I3,' NOVERLAP=',I3)
WRITE(IOUT,FMT=6014) (I,IX(I),IY(I),IREC(I),I=1,NDEBUG(44))
IF (ONLINE) WRITE(ITOUT,FMT=6014)
+ (I,IX(I),IY(I),IREC(I),I=1,NDEBUG(44))
6014 FORMAT(1X,'LIST OF FIRST RECORDS',/,(1X,4I6))
END IF
END IF
C
IDR = 1
IF (XDEBUG) NDBG = 0
C
DO 2 I = 1,5
C
C---- Reduce the peak size by 2*ITRIM pixels to minimise overlap
C
IF (I.LE.2) THEN
KRAS(I) = LRAS(I)
ELSE
KRAS(I) = LRAS(I) + ITRIM
END IF
2 CONTINUE
C
NHX = NXX/2
NHY = NYY/2
C
IF (DEBUG(44).AND.(NDBG.LE.NDEBUG(44))) THEN
NDBG = NDBG + 1
KREC = ABS(IRECS)
CALL GETHKL(KREC,IHKL)
IR = IRG(KREC)
WRITE(IOUT,FMT=6016) (IHKL(I),I=1,3),IRECS,
+ IXS,IYS,IR,ISTART,JSTART,LRAS
IF (ONLINE) WRITE(ITOUT,FMT=6016) (IHKL(I),I=1,3),IRECS,
+ IXS,IYS,IR,ISTART,JSTART,LRAS
6016 FORMAT(//1X,'Testing reflection',3I4,' record ',I6,' Pixel ',
+ 'coords',2I6,' Flag',I2,/,1X,' ISTART',I6,' JSTART',I6,
+ ' raster',5I3)
END IF
C
DO 4 IJ = 1,200
NUMB(IJ,1) = 1
4 CONTINUE
C
C
C---- Find this record in the COORD list to extract 10micron coords
C
DO 10 I = ISTART,NTOT
IF (IRECS.EQ.IREC(I)) THEN
IS = I
GOTO 12
END IF
10 CONTINUE
C
C---- Not found, error
C
WRITE(IOUT,FMT=6012) IRECS,ISTART,NTOT
IF (ONLINE) WRITE(ITOUT,FMT=6012) IRECS,ISTART,NTOT
6012 FORMAT(/,1X,'***** FATAL ERROR *****',/,1X,'Cannot find ',
+ 'record',I6,' in COORD file, ISTART=',I6,' NTOT=',I6,/,1X,
+ 'The most common reason for this error is running two ',
+ 'jobs simultaneously in the same directory.',/,1X,
+ 'If you want to do this, and are using the "SEPARATION ',
+ 'CLOSE" option, you MUST assign the',/,1X,'logical ',
+ 'filename COORDS to a unique file for each job in the ',
+ 'ipmosflm command line.',/,1X,
+ 'eg: ipmosflm COORDS job1.coords SUMMARY job1.sum ',
+ ' SPOTOD job1.spotod << eof-mos')
CALL SHUTDOWN
C
C---- Record found, set ISTART for search for next reflection. Need to
C backtrack because reflections with the same X PIXEL coordinate
C will not necessarily be in the same order in the sorted 10micron
C pixel list stored in COORD. Backtrack to previous reflection
C with a smaller pixel coordinate.
C
12 IF (IS.EQ.1) THEN
ISTART = 1
ELSE
DO 14 I = IS-1,1,-1
IXP1 = NINT(IX(I)*FACT)
IF (IXP1.LT.(IXS-1)) THEN
ISTART = I
GOTO 16
END IF
14 CONTINUE
ISTART = 1
END IF
C
16 IX1 = IX(IS)
IY1 = IY(IS)
C
C---- Convert 10 micron units to pixels
C
IXP1 = NINT(IX1*FACT)
IYP1 = NINT(IY1*FACT)
C
C---- Check against input pixel coords
C
IF ((ABS(IXP1-IXS).GT.1).OR.(ABS(IYP1-IYS).GT.1)) THEN
WRITE(IOUT,FMT=6022) IRECS,IXS,IYS,IXP1,IYP1,ISTART,NTOT
IF (ONLINE) WRITE(ITOUT,FMT=6022) IRECS,IXS,IYS,IXP1,IYP1,
+ ISTART,NTOT
6022 FORMAT(1X,'*****ERROR *****',/,1X,'Pixel coords do not match',
+ ' for record',I5,/,1X,'Input coords',2I6,
+ ' coords from file COORD',2I6,' ISTART',I6,' NTOT',I6)
CALL SHUTDOWN
END IF
C
C---- Set up mask for this spot
C
C ***********************
CALL SETMASK(MASK(1),LRAS)
C ***********************
C
NXYB = NXX*NYY
C
C---- Initialise LMASK to 0 for all pixels. Overlapped pixels will be
C flagged with LMASK set non-zero
C
DO 18 IJ = 1,NXYB
LMASK(IJ) = 0
18 CONTINUE
C
C---- Min separation: Peak of one box overlaps other box if
C separation l.e. min.
C
MINX = (2*NHX - NRX)
MINY = (2*NHY - NRY)
JSEP = 0
C
C---- Secrh through reflection coordinate list looking for overlaps
C
DO 30 J = JSTART,NTOT
C
C---- Skip if this is the same spot
C
IF (IRECS.EQ.IREC(J)) GOTO 30
IX2 = IX(J)
IY2 = IY(J)
C
C---- Find the first reflection close enough to overlap but with smaller X
C coord
C
IF (NINT((IX1-IX2)*FACT).GT.MINX) THEN
JST = J
GOTO 30
END IF
IDX = NINT((IX2 - IX1)*FACT)
IF (IDX.GT.MINX) GOTO 40
IDY = NINT((IY2 - IY1)*FACT)
IF (ABS(IDY).GT.MINY) GOTO 30
C
C---- This is a new overlap
C
JSEP = JSEP + 1
IF (DEBUG(44).AND.(NDBG.LE.NDEBUG(44))) THEN
WRITE(IOUT,FMT=6009) IDX,IDY,IREC(J)
IF (ONLINE) WRITE(ITOUT,FMT=6009) IDX,IDY,IREC(J)
END IF
6009 FORMAT(1X,'New separation with IDX=',I3,'IDY=',I3,' due to',
+ ' record number',I6)
IF (JSEP.GT.200) THEN
WRITE(IOUT,FMT=6010)
6010 FORMAT(//1X,'*** FATAL ERROR IN MASKONE ***',/,1X,'More than',
+ ' 200 different separations ',/,1X,'Try defining',
+ ' more standard profile areas using PROFILE XLINES,',
+ ' YLINES')
CALL SHUTDOWN
END IF
IDXSTORE(JSEP,1) = IDX
IDYSTORE(JSEP,1) = IDY
C
C---- Peak background overlap possible. Use MASK to determine actual
C overlapping pixels
C
ISEPX = NHX - NRX
ISEPY = NHY - NRY
IOFFSET = IDX*NYY + IDY
CALL MOVLAP(MASK,NHX,NHY,IDX,IDY,ISEPX,ISEPY,JSEP,IOFFSET,
+ LMASK)
C
C---- End of loop over secondary reflections "J"
C
30 CONTINUE
C
C---- No additional overlap possible
C
C---- Set JSTART for search for next reflection. Need to
C backtrack because reflections with the same X PIXEL coordinate
C will not necessarily be in the same order in the sorted 10micron
C pixel list stored in COORD. Backtrack to previous reflection
C with a smaller pixel coordinate.
C
40 IXJST = NINT(IX(JST)*FACT)
IF (JST.EQ.1) THEN
JSTART = 1
ELSE
DO 42 I = JST-1,1,-1
IXP1 = NINT(IX(I)*FACT)
IF (IXP1.LT.(IXJST-1)) THEN
JSTART = I
GOTO 44
END IF
42 CONTINUE
JSTART = 1
END IF
44 NSEP = JSEP
IF (DEBUG(44).AND.(NDBG.LE.NDEBUG(44))) THEN
WRITE(IOUT,FMT=6006) NSEP,(IDXSTORE(I,1),
+ IDYSTORE(I,1),NUMB(I,1),I=1,NSEP)
IF (ONLINE) WRITE(ITOUT,FMT=6006) NSEP,
+ (IDXSTORE(I,1),
+ IDYSTORE(I,1),NUMB(I,1),I=1,NSEP)
6006 FORMAT(/1X,'There are',I3,' different',
+ ' separations as below',/,1X,' IDX IDY Number',/,
+ (1X,2I5,I7))
END IF
C
C
C---- Now set up MASKREJ using LMASK.
C
C ***********************
CALL SETMASK(MASK(1),LRAS)
C ***********************
NREJ = 1
NREJP = 1
DO 50 K = 1,NXYB
IF (LMASK(K).NE.0) THEN
C
C---- *** IMPORTANT *** ONLY include rejected BACKGROUND pixels in MASKREJ
C
IF (MASK(K).EQ.-1) THEN
NREJ = NREJ + 1
C
C---- Trap more than NREJMAX rejected background pixels
C
IF (NREJ.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
6008 FORMAT(//1X,'****** FATAL ERROR ******',/,1X,
+ 'More than ',I5,
+ ' Background pixels rejected due to overlap of ',
+ 'neighbouring',/,1X,'spots. Check that the minimum ',
+ 'allowed spot separation (SEPARATION keyword)',/,1X,'is ',
+ 'appropriate for this image...problems will arise if',
+ ' these values are',/,1X,'too small',/,1X,'If this is not',
+ ' the problem, try to reduce the overall size of the',/,1X,
+ 'measurement box. If profile optimisation is being used',
+ ' (this is the default)',/,1X,'then PROFILE RATIO keywords'
+ ,' determine how large the overall box will be.',/,1X,
+ 'Reduce RATIO to get a smaller box, or alternatively use',
+ ' PROFILE FIXBOX',/,1X,'keywords to prevent optimisation',
+ ' of the overall dimensions of the box.',
+ /,1X,'If this is not a',
+ ' viable option, change parameter NREJMAX to a larger ',
+ /,1X,'and recompile the program')
C
MASKREJ(NREJ) = K
ELSE IF (MASK(K).EQ.1) THEN
NREJP = NREJP + 1
C
C---- Trap more than NREJMAX rejected peak pixels
C
IF (NREJP.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
MASKREJP(NREJP) = K
END IF
END IF
50 CONTINUE
MASKREJ(1) = NREJ - 1
MASKREJP(1) = NREJP - 1
NREJP = NREJP - 1
C
C---- Set WARNing flag if there are overlapped peak pixels
C
IF ((.NOT.WARN(1)).AND.NREJP.GT.0.AND.MODE.EQ.3)
+ WARN(1) = .TRUE.
C
C---- Now set up PQSUMS and PQSUMINV for this box
C
CALL BGSUMS(MASK,LMASK,OD,NHX,NHY,PQSUMS,SPQOD)
C
C **************************************
CALL PQINV(PQSUMS(1),PQSUMINV(1))
C **************************************
C
IF (DEBUG(44).AND.(NDBG.LE.NDEBUG(44))) THEN
WRITE(IOUT,FMT=6004) LRAS,MASKREJ(1),NREJP,
+ (PQSUMS(K),K=1,6),(PQSUMINV(K),K=1,9)
IF (ONLINE) WRITE(ITOUT,FMT=6004)LRAS,MASKREJ(1),
+ NREJP,(PQSUMS(K),K=1,6),(PQSUMINV(K),
+ K=1,9)
6004 FORMAT(1X,'Raster parameters',5I3,/,1X,
+ 'Number rejected background pixels',I4,
+ ' number rejected peak pixels',I4,/,1X,
+ 'PQSUMS',6F12.0,/,1X,'PQSUMINV',9F12.8)
END IF
C
C---- Print raster masks if required
C
IF (DEBUG(44).AND.(NDBG.LE.NDEBUG(44))) THEN
C ***********************
CALL SETMASK(MASK(1),LRAS)
C ***********************
C ******************************************
CALL RASPLOT4(LPROFL,NXX,NYY,MASK(1),
+ MASKREJ(1),IDR)
C ******************************************
END IF
C
C---- Check that there are enough background points
C
IF (PQSUMS(6).GT.RECLEVEL*NBGMIN) RETURN
C
C---- Not enough background points. Trim all peaks and redetermine number
C of points
NSAVE = PQSUMS(6)
ITR = 0
60 ITR = ITR + 1
DO 61 I = 1,NXYB
JMASK(I) = 0
61 CONTINUE
C
C---- Set up new mask for trimmed peaks
C
DO 62 I = 3,5
KRAS(I) = LRAS(I) + ITR
62 CONTINUE
C
C---- If peak is less than 3 pixels across, give up !
C
IF ((NXX-2*KRAS(4).LT.3).OR.(NYY -2*KRAS(5).LT.3)) THEN
IFLAG = 99
RETURN
END IF
C
C ***********************
CALL SETMASK(MASK(1),KRAS)
C ***********************
C
C---- Loop over overlapping spots and set up JMASK of overlapped pixels
C
ISEPX = NHX - KRAS(4)
ISEPY = NHY - KRAS(5)
DO 68 I = 1,NSEP
IDX = IDXSTORE(I,1)
IDY = IDYSTORE(I,1)
IOFFSET = IDX*NYY + IDY
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6068) I,IDX,IDY,ISEPX,ISEPY,KRAS
IF (ONLINE) WRITE(ITOUT,FMT=6068) I,IDX,IDY,ISEPX,ISEPY,
+ KRAS
6068 FORMAT(1X,'I=',I2,' IDX',I4,' IDY',I4,' ISEPX',I3,
+ ' ISEPY',I3,' KRAS',5I3)
END IF
CALL MOVLAP(MASK,NHX,NHY,IDX,IDY,ISEPX,ISEPY,I,IOFFSET,
+ JMASK)
68 CONTINUE
C
C
C---- Now set up PQSUMS and PQSUMINV for this box using JMASK
C
C
C---- Set up mask again using LRAS for this spot
C
C ***********************
CALL SETMASK(MASK(1),LRAS)
C ***********************
CALL BGSUMS(MASK,JMASK,OD,NHX,NHY,PQSUMS,SPQOD)
C **************************************
CALL PQINV(PQSUMS(1),PQSUMINV(1))
C **************************************
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6030) NSEP,NSAVE,PQSUMS(6),ITR
IF (ONLINE) WRITE(ITOUT,FMT=6030) NSEP,NSAVE,PQSUMS(6),ITR
6030 FORMAT(1X,'Spot has',I2,' overlapping spots, original number',
+ 'of background pixels',I4,' after trimming ',F5.0,
+ ' trim now',I2,
+ /,1X,'Array LMASK follows',/)
MAXPIX = 99
CALL ODPLOT4(LMASK,NXX,NYY,IDR,MAXPIX)
WRITE(IOUT,FMT=6032)
IF (ONLINE) WRITE(ITOUT,FMT=6032)
6032 FORMAT(/,1X,'Array JMASK',/)
CALL ODPLOT4(JMASK,NXX,NYY,IDR,MAXPIX)
END IF
C
C---- Check that there are enough background points, if not, trim again
C
IF (PQSUMS(6).LT.RECLEVEL*NBGMIN) GOTO 60
C
C---- Now have enough background points. Now choose the weakest spots
C to be trimmed, ensuring there are still enough background pixels
C
C First get the background plane parameters
C
C---- Background constants
C
C
C
C **************************
CALL MATVEC(ABC,PQSUMINV,SPQOD)
C **************************
C
A = ABC(1)
B = ABC(2)
C = ABC(3)
C
DO 80 I = 1,NSEP
NPXBG(I) = 0
SUMOD(I) = 0
80 CONTINUE
C
C---- Loop over pixels again, and find mean background subtracted signal
C for the recovered background pixels (by trimming the peak) for
C each of the overlapping spots, in order to find the weakest
C
IJ = 0
SBGOD = 0.0
SBGPOD = 0
SBGQOD = 0
DO 84 P = -NHX,NHX
DO 82 Q = -NHY,NHY
IJ = IJ + 1
IOD = OD(IJ)
C
C
IF ((MASK(IJ).EQ.-1).AND.(LMASK(IJ).NE.0).AND.
+ (JMASK(IJ).EQ.0)) THEN
C
C
C---- Sums for background, dont include pixels overlapped by 2 spots
C
IF (LMASK(IJ).EQ.100) GOTO 82
I = LMASK(IJ)
NPXBG(I) = NPXBG(I) + 1
SUMOD(I) = SUMOD(I) + IOD - A*P -B*Q - C
CAL IF (XDEBUG) THEN
CAL WRITE(IOUT,FMT=6060) P,Q,I,IOD,SUMOD(I)
CAL IF (ONLINE) WRITE(ITOUT,FMT=6060) P,Q,I,IOD,SUMOD(I)
CAL 6060 FORMAT(1X,'P,Q',2I4,' I',I2,' IOD',I8,' SUMOD(I)',I8)
CAL END IF
END IF
C
82 CONTINUE
84 CONTINUE
C
C---- Find mean
C
DO 86 I = 1,NSEP
IF (NPXBG(I).EQ.0) THEN
SUMOD(I) = 100000
GOTO 86
END IF
SUMOD(I) = SUMOD(I)/NPXBG(I)
86 CONTINUE
C
CALL SORTUP4(NSEP,SUMOD,IORDER)
C
DO 90 I = 1,NSEP
J = IORDER(I)
NSAVE = NSAVE + NPXBG(J)
IF (NSAVE.GT.NINT(RECLEVEL*NBGMIN)) THEN
NREJS = I
GOTO 92
END IF
90 CONTINUE
NREJS = NSEP
GOTO 94
C
C---- Now know how many spots have to be trimmed and which ones to choose.
C First check if the next spot is significantly stronger, if not then
C trim it as well to improve background determination.
C
92 IF (NREJS.EQ.NSEP) GOTO 94
J = IORDER(NREJS)
K = IORDER(NREJS+1)
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6062) NREJS,K,J
IF (ONLINE) WRITE(ITOUT,FMT=6062) NREJS,K,J
6062 FORMAT(1X,'NREJS=',I3,' test spot',I2,' against',I2)
END IF
TOTOD = C+SUMOD(J)
IF (TOTOD.LT.0.0) TOTOD = 0.001
IF ((SUMOD(K)-SUMOD(J)).LT.
+ 3.0*SQRT(GAIN*TOTOD)) THEN
NREJS = NREJS + 1
IF (NREJS.LT.NSEP) GOTO 92
END IF
C
C---- Set up the final mask with each spot trimmed as necessary
C Do the weaker spots first, using the current parameters in KRAS.
C Then for the remaining spots (if any) decrease the rim parameters by
C one.
C
94 IF (XDEBUG) THEN
WRITE(IOUT,FMT=6040) A,B,C,NREJS,(NPXBG(I),SUMOD(I),I=1,NSEP)
IF (ONLINE) WRITE(ITOUT,FMT=6040) A,B,C,NREJS,
+ (NPXBG(I),SUMOD(I),I=1,NSEP)
6040 FORMAT(1X,'Background plane constants',2F6.1,F8.1,/,1X,
+ 'Number of spots to be trimmed',I3,/,1X,
+ 'Number of pixels and mean signal for each overlapping',
+ ' spot',/,1X,12(I3,I8))
END IF
FIRST = .TRUE.
DO 95 I = 1,NXYB
JMASK(I) = 0
95 CONTINUE
C
C ***********************
CALL SETMASK(MASK(1),KRAS)
C ***********************
C
DO 98 I = 1,NSEP
J = IORDER(I)
C
C---- For first stronger spot, reset raster params, MASK and ISEPX,ISEPY
C
IF ((I.GT.NREJS).AND.FIRST) THEN
FIRST = .FALSE.
DO 96 K = 3,5
KRAS(K) = KRAS(K) - 1
96 CONTINUE
CALL SETMASK(MASK(1),KRAS)
ISEPX = NHX - KRAS(4)
ISEPY = NHY - KRAS(5)
END IF
IDX = IDXSTORE(J,1)
IDY = IDYSTORE(J,1)
IOFFSET = IDX*NYY + IDY
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6066) I,J,IDX,IDY,ISEPX,ISEPY,KRAS
IF (ONLINE) WRITE(ITOUT,FMT=6066) I,J,IDX,IDY,ISEPX,ISEPY,
+ KRAS
6066 FORMAT(1X,'I=',I2,' J=',I2,' IDX',I4,' IDY',I4,' ISEPX',I3,
+ ' ISEPY',I3,' KRAS',5I3)
END IF
CALL MOVLAP(MASK,NHX,NHY,IDX,IDY,ISEPX,ISEPY,J,IOFFSET,
+ JMASK)
98 CONTINUE
C
C---- JMASK now contains the modified mask, use this to set up PQSUMS
C
CALL SETMASK(MASK(1),LRAS)
CALL BGSUMS(MASK,JMASK,OD,NHX,NHY,PQSUMS,SPQOD)
C **************************************
CALL PQINV(PQSUMS(1),PQSUMINV(1))
C **************************************
C
C---- Now set up MASKREJ,MASKREJP using new JMASK
C
NREJ = 1
NREJP = 1
DO 100 K = 1,NXYB
IF (JMASK(K).NE.0) THEN
C
C---- *** IMPORTANT *** ONLY include rejected BACKGROUND pixels in MASKREJ
C
IF (MASK(K).EQ.-1) THEN
NREJ = NREJ + 1
C
C---- Trap more than NREJMAX rejected background pixels
C
IF (NREJ.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
C
MASKREJ(NREJ) = K
ELSE IF (MASK(K).EQ.1) THEN
NREJP = NREJP + 1
C
C---- Trap more than NREJMAX rejected peak pixels
C
IF (NREJP.GT.NREJMAX-1) THEN
WRITE(IOUT,FMT=6008) NREJMAX
IF (ONLINE) WRITE(ITOUT,FMT=6008) NREJMAX
CALL SHUTDOWN
END IF
MASKREJP(NREJP) = K
END IF
END IF
100 CONTINUE
MASKREJ(1) = NREJ - 1
MASKREJP(1) = NREJP - 1
NREJP = NREJP - 1
C
IF (XDEBUG) THEN
WRITE(IOUT,FMT=6044) PQSUMS(6),PQSUMS,PQSUMINV,NREJ-1,NREJP
IF (ONLINE) WRITE(ITOUT,FMT=6044) PQSUMS(6),PQSUMS,PQSUMINV,
+ NREJ-1,NREJP
6044 FORMAT(1X,'Final number of background pixels',F5.0,/,1X,
+ 'PQSUMS',6F12.0,/,1X,'PQSUMINV',9F12.8,/,1X,
+ 'Number rejected background pixels',I5,3X,
+ 'Number rejected peak pixels',I5,
+ ' modified mask',/)
CALL ODPLOT4(JMASK,NXX,NYY,IDR,MAXPIX)
END IF
RETURN
END
!------------------------------------------------------------------------------
!MAT_VEC_MUL_3X3: post-multiply a 3x3 matrix by a 3 vector
!
! This code was cribbed unashamedly from Ingo Steller's code from
! DPS_INDEX
!______________________________________________________________________________
SUBROUTINE MAT_VEC_MUL_3X3(MATRIX,X,Y,Z)
REAL NEW_VEC(3), X,Y,Z, MATRIX(3,3)
NEW_VEC(1) = MATRIX(1,1)*X +
$ MATRIX(1,2)*Y +
$ MATRIX(1,3)*Z
NEW_VEC(2) = MATRIX(2,1)*X +
$ MATRIX(2,2)*Y +
$ MATRIX(2,3)*Z
NEW_VEC(3) = MATRIX(3,1)*X +
$ MATRIX(3,2)*Y +
$ MATRIX(3,3)*Z
X = NEW_VEC(1)
Y = NEW_VEC(2)
Z = NEW_VEC(3)
RETURN
END
!==============================================================================
C== MATCOP ==
C
C
SUBROUTINE MATCOPF(A,B,M,N)
C =========================
C
C---- Copy an NxN matrix to another one
C
C A=B
C
IMPLICIT NONE
C .. Scalar Arguments ..
INTEGER M,N
C .. Array Arguments ..
REAL A(M,N),B(M,N)
C ..
C .. Local Scalars ..
INTEGER I,J
C ..
C
C
DO 20 I = 1,M
DO 10 J = 1,N
A(I,J) = B(I,J)
10 CONTINUE
20 CONTINUE
C
C
END
C== MATMUL3 ==
C
C
SUBROUTINE MATMUL3(A,B,C)
C =========================
C
C---- Multiply 2 3x3 matrices
C
C A=BC
C
C .. Array Arguments ..
REAL A(3,3),B(3,3),C(3,3)
C ..
C .. Local Scalars ..
REAL S
INTEGER I,J,K
C ..
SAVE
C
C
DO 30 I = 1,3
DO 20 J = 1,3
S = 0
DO 10 K = 1,3
S = B(I,K)*C(K,J) + S
10 CONTINUE
A(I,J) = S
20 CONTINUE
30 CONTINUE
C
C
END
C== MATSET ==
C
C
SUBROUTINE MATSET(UCELL,NRCELL,IPRINT)
C =====================================
C
C
C---- Calculates A = U x B matrix and its derivatives
C wrt. cell parameters
C The UMAT is passed in through /CELL/ but BMAT must be calculated
C using the latest (refined) cell parameters
C---- Cell dimension matrices and derivatives in common CELL
C Angles in radians, real cell edges in Angstrom
C
C Input:
C UCELL The unique refinable/refined cell parameters
C NRCELL Number of refined parameters
C IPRINT Print flag, gives debug output if .ge.2
C
C
C .. Scalar Arguments ..
INTEGER IPRINT,NRCELL
C ..
C .. Array Arguments ..
REAL UCELL(6)
C ..
C .. Local Scalars ..
REAL A,AA,B,BA,C,CA,CB,CCC,CG,CTT,FAC,GA,RAPI,SA,SB,SG
INTEGER I,J,K,L,LC,N
C ..
C .. Local Arrays ..
REAL TMAT(3,3)
C ..
C .. External Subroutines ..
EXTERNAL CLEAR,MATMUL3
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN,COS,SIN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/idxcell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file idxcell.h
C---- START of include file idxcell.h
C
C ..
C ..
C .. Arrays in Common /IDXCELL/ ..
REAL DUBDCC
C ..
C .. Common blocks ..
COMMON /IDXCELL/ DUBDCC(3,3,6)
C ..
C
C
C&&*&& end_include ../inc/idxcell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C ..
SAVE
C
C
RAPI = ATAN(1.0)*4.0/180.0
C
C---- Clear matrices
C
C ***********
CALL CLEAR(BMAT)
C ***********
C
DO 10 I = 1,6
C
C ********************
CALL CLEAR(DUBDCC(1,1,I))
C ********************
C
10 CONTINUE
C
C---- Move refined cell parameters back into RCELL
C
IF (NRCELL.GT.0) THEN
N = 0
C
C
DO 20 I = 1,6
LC = LCELL(I)
C
C
IF (LC.EQ.-1) THEN
N = N + 1
RCELL(I) = UCELL(N)
ELSE IF (LC.GT.0) THEN
RCELL(I) = RCELL(LC)
END IF
20 CONTINUE
C
C
END IF
C
C---- Cell dimensions
C
A = RCELL(1)
B = RCELL(2)
C = RCELL(3)
AA = RCELL(4)*RAPI
BA = RCELL(5)*RAPI
GA = RCELL(6)*RAPI
C
SA = SIN(AA)
SB = SIN(BA)
SG = SIN(GA)
CA = COS(AA)
CB = COS(BA)
CG = COS(GA)
CCC = (CA-CB*CG)/SG
C
C---- FAC = V/ABC OR V* / A* B* C*
C
STEMP = 2*CA*CB*CG + 1.0 - CA*CA-CB*CB-CG*CG
IF (STEMP.LT.0.0) WRITE(6,8888) STEMP
8888 FORMAT(' FAC FROM MATSET = ',F20.10)
FAC = SQRT(STEMP)
C
C---- CTT = cos(c*,c)
C
CTT = FAC/SG
C
C---- Orthogonalization matrix B
C
BMAT(1,1) = A
BMAT(1,2) = B*CG
BMAT(1,3) = C*CB
BMAT(2,2) = B*SG
BMAT(2,3) = C*CCC
BMAT(3,3) = C*CTT
C
C---- Rotate by matrix U to give matrix UB
C
C ************************
CALL MATMUL3(AMAT,UMAT,BMAT)
C ************************
C
C---- If no refined cell parameters skip derivative calculation
C
IF (NRCELL.NE.0) THEN
C
C---- Derivative matrices d UB / d cell parameter
C
C---- a*
C
C ***********
CALL CLEAR(TMAT)
C ***********
C
TMAT(1,1) = 1.0
C
C ********************************
CALL MATMUL3(DUBDCC(1,1,1),UMAT,TMAT)
C ********************************
C
C---- b*
C
C ***********
CALL CLEAR(TMAT)
C ***********
C
TMAT(1,2) = CG
TMAT(2,2) = SG
C
C ********************************
CALL MATMUL3(DUBDCC(1,1,2),UMAT,TMAT)
C ********************************
C
C---- c*
C
C ***********
CALL CLEAR(TMAT)
C ***********
C
TMAT(1,3) = CB
TMAT(2,3) = CCC
TMAT(3,3) = CTT
C
C ********************************
CALL MATMUL3(DUBDCC(1,1,3),UMAT,TMAT)
C ********************************
C
C
C---- alpha *
C
C ***********
CALL CLEAR(TMAT)
C ***********
C
TMAT(2,3) = -C*SA/SG
TMAT(3,3) = C*SA*CCC/FAC
C
C ********************************
CALL MATMUL3(DUBDCC(1,1,4),UMAT,TMAT)
C ********************************
C
C---- beta *
C
C ***********
CALL CLEAR(TMAT)
C ***********
C
TMAT(1,3) = -C*SB
TMAT(2,3) = -C*SB*CG/SG
TMAT(3,3) = C*SB* (CB-CA*CG)/ (FAC*SG)
C
C ********************************
CALL MATMUL3(DUBDCC(1,1,5),UMAT,TMAT)
C ********************************
C
C---- gamma *
C
C ***********
CALL CLEAR(TMAT)
C ***********
C
TMAT(1,2) = -B*SG
TMAT(2,2) = B*CG
TMAT(2,3) = (CB-CCC*CG/SG)*C
TMAT(3,3) = ((CG-CA*CB)/FAC-CTT*CG/SG)*C
C
C ********************************
CALL MATMUL3(DUBDCC(1,1,6),UMAT,TMAT)
C ********************************
C
C---- Compress derivative matrices into set corresponding to
C unique refineable cell parameters
C
DO 50 K = 1,6
LC = LCELL(K)
C
C
IF (LC.GT.0) THEN
C
C
DO 40 I = 1,3
DO 30 J = 1,3
DUBDCC(I,J,LC) = DUBDCC(I,J,LC) + DUBDCC(I,J,K)
30 CONTINUE
40 CONTINUE
C
C
END IF
50 CONTINUE
C
C
N = 0
C
C
DO 80 K = 1,6
IF (LCELL(K).EQ.-1) THEN
N = N + 1
IF (N.NE.K) THEN
DO 70 I = 1,3
DO 60 J = 1,3
DUBDCC(I,J,N) = DUBDCC(I,J,K)
60 CONTINUE
70 CONTINUE
END IF
END IF
80 CONTINUE
END IF
C
C
IF (IPRINT.GE.2) THEN
WRITE (ITOUT,FMT=6000) ((AMAT(I,J),J=1,3),I=1,3)
WRITE (ITOUT,FMT=6002)
+ (((DUBDCC(I,J,L),J=1,3),I=1,3),L=1,N)
END IF
C
C---- Format statements
C
6000 FORMAT (/' MATSET: AMAT',/ (3 (11X,3F10.5,/),/))
6002 FORMAT (/' DUBDCC',/ (6 (3 (11X,3F10.5,/),/),/))
C
C
END
C== MATVEC ==
C
C
C
SUBROUTINE MATVEC(V,A,B)
C ========================
C
C---- Post-multiply a 3x3 matrix by a vector
C
C V=AB
C
C
C
C .. Array Arguments ..
REAL A(3,3),B(3),V(3)
C ..
C .. Local Scalars ..
C
C
REAL S
INTEGER I,J
C ..
C
C
DO 20 I = 1,3
S = 0
C
C
DO 10 J = 1,3
S = A(I,J)*B(J) + S
10 CONTINUE
C
C
V(I) = S
20 CONTINUE
C
C
END
C== MATVEC4 ==
C
C
SUBROUTINE MATVEC4(V,A,B)
C =========================
C
C---- Post-multiply a 4x4 matrix by a vector
C
C V=AB
C
C .. Array Arguments ..
REAL A(4,4),B(4),V(4)
C ..
C .. Local Scalars ..
REAL S
INTEGER I,J
C ..
SAVE
C
C
DO 20 I = 1,4
S = 0
DO 10 J = 1,4
S = A(I,J)*B(J) + S
10 CONTINUE
V(I) = S
20 CONTINUE
C
C
END
C== MDOCAL ==
REAL FUNCTION MDOCAL(VALUE,OPER,VALUE0)
C =======================================
C
C---- Do simple arithmetic on two arguments
C
C
C
C .. Scalar Arguments ..
REAL VALUE,VALUE0
INTEGER OPER
C ..
C .. Local Scalars ..
INTEGER DIVIDE,EENOTN,MINUS,MULT,PLUS
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Data statements ..
DATA PLUS/1/,MINUS/2/,MULT/3/,DIVIDE/4/,EENOTN/5/
C ..
C
C
IF (OPER.EQ.PLUS) MDOCAL = VALUE0 + VALUE
IF (OPER.EQ.MINUS) MDOCAL = VALUE0 - VALUE
IF (OPER.EQ.MULT) MDOCAL = VALUE0*VALUE
IF (OPER.EQ.DIVIDE) THEN
IF (VALUE.NE.0.0) MDOCAL = VALUE0/VALUE
IF (VALUE.EQ.0.0) MDOCAL = 0.0
END IF
IF (OPER.EQ.EENOTN) THEN
IF (ABS(VALUE).LE.76.0) MDOCAL = VALUE0* (10.0**VALUE)
IF (ABS(VALUE).GT.76.0) MDOCAL = 0.0
END IF
C
C
END
C== MEANPRO ==
C
SUBROUTINE MEANPRO(OD,JBOX,NEIGHBR,IPASS,NOVRL,NWK,MAXOD,
+ MINOD,NRFSAVE,NOVRLSAVE,NWKSAVE,SAVESCAL,
+ CBOX,CBOXAV)
C ===========================================================
C
IMPLICIT NONE
C---- Form an averaged profile by adding in the profiles of neighbouring
C boxes, converted back to pixel counts (ie no scale factor applied)
C The averaged profile is returned in OD.
C
C
C****** DEBUG(22) FOR THIS SUBROUTINE ******
C
C--- Bug found in this code 19/9/91. Now corrected. Bug lead to I*4 overflow
C with image plate data, but would not affect profile shape.
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IPASS,JBOX,MAXOD,MINOD
C ..
C .. Array Arguments ..
INTEGER NEIGHBR(9),NOVRL(NMASKS),NOVRLSAVE(NMASKS),
+ NRFSAVE(NMASKS),NWK(NMASKS),NWKSAVE(NMASKS),OD(MAXBOX)
REAL SAVESCAL(NMASKS,2),CBOX(NMASKS),CBOXAV(NMASKS)
C ..
C .. Local Scalars ..
REAL ODMIN,SCALE,SUMFLG,XMULT
INTEGER I,IN,IOD,J,K,KBOX,KNX,KNXY,KNY,N,N1,N2,NCOMMONX,
+ NCOMMONY,NDIFFX,NDIFFY,NOVRLSUM,NP,NRF,NRFSUM,NRX,NRY,
+ NWKSUM,NX,NXY,NY,MAXPIX
LOGICAL BIGGERX,BIGGERY
C ..
C .. Local Arrays ..
INTEGER*2 IFLAG(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL ODPLOT4,ODPLOT,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,MIN,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C
MAXOD = 0
MINOD = 99999
C
C---- Set up neighbours to be used in averaging and inital sums
C
IF (IPASS.EQ.1) THEN
N1 = 2
N2 = 5
NRFSUM = NRFBOX(JBOX)
NWKSUM = NWK(JBOX)
NOVRLSUM = NOVRL(JBOX)
CBOXAV(JBOX) = CBOX(JBOX)
ELSE
N1 = 6
N2 = 9
END IF
C
C
NX = ISIZE(JBOX,1)
NY = ISIZE(JBOX,2)
NXY = NX*NY
C
C---- First scale up ods for jbox by number of reflections used
C in forming profile and scalefactor and offset applied in stdprof,
C so that the final numbers are the original od sums except that
C the background has been subtracted.
C note if ipass=2, xmult comes from the
C previous call with ipass=1 which sets up iflag
C iflag keeps track of how many reflections are contributing to
C each pixel in averaged profile
C
C
C
IF (IPASS.EQ.1) THEN
SCALE = SAVESCAL(JBOX,1)
ODMIN = SAVESCAL(JBOX,2)
XMULT = 1.0
ELSE
SCALE = 1.0
ODMIN = 0
END IF
C
C
IF (DEBUG(22)) THEN
WRITE(IOUT,FMT=6014) IPASS,SCALE,ODMIN,XMULT
IF (ONLINE) WRITE(ITOUT,FMT=6014) IPASS,SCALE,ODMIN,XMULT
6014 FORMAT(1X,'IPASS=',I2,' SCALE=',F9.2,' ODMIN=',F9.1,
+ ' XMULT=',F6.1)
END IF
C
DO 10 K = 1,NXY
IF (IPASS.EQ.1) THEN
IFLAG(K) = NRFSUM
ELSE
IF (SUMFLG.NE.0.0) XMULT = REAL(IFLAG(K))/SUMFLG
END IF
C
C---- Skip if no reflections in this box (may only contain
C partials in first pass)
C
IF (NRFSUM.NE.0) OD(K) = (REAL(OD(K))/SCALE+ODMIN)*XMULT
IF(DEBUG(22).AND.(K.LT.20)) WRITE(6,*)'K,XMULT,OD(K)',
+ K,XMULT,OD(K)
10 CONTINUE
C
C---- Debug
C
IF (DEBUG(22)) THEN
WRITE (IOUT,FMT=6016)
IF (ONLINE) WRITE (ITOUT,FMT=6016)
MAXPIX = 0
CALL ODPLOT4(OD,NX,NY,1,MAXPIX)
END IF
6016 FORMAT(//1X,'Original ods, but background subtracted')
C
C---- Now loop over neighbours
C
DO 40 IN = N1,N2
N = 1
NP = 1
KBOX = NEIGHBR(IN)
C
C
IF (KBOX.NE.0) THEN
C
C---- Add in total background counts (plane constant c)
C
CBOXAV(JBOX) = CBOXAV(JBOX) + CBOX(KBOX)
NRF = NRFBOX(KBOX)
NOVRLSUM = NOVRL(KBOX) + NOVRLSUM
NWKSUM = NWK(KBOX) + NWKSUM
SCALE = SAVESCAL(KBOX,1)
ODMIN = SAVESCAL(KBOX,2)
C
C
IF (DEBUG(22)) THEN
WRITE (IOUT,FMT=6000) NRF,KBOX,JBOX,IPASS,SCALE,ODMIN
IF (ONLINE) WRITE (ITOUT,FMT=6000) NRF,KBOX,JBOX,IPASS,
+ SCALE,ODMIN
END IF
C
NRFSUM = NRFSUM + NRF
KNX = ISIZE(KBOX,1)
KNY = ISIZE(KBOX,2)
KNXY = KNX*KNY
BIGGERX = (NX.GT.KNX)
BIGGERY = (NY.GT.KNY)
NDIFFX = ABS(NX-KNX)
NDIFFY = ABS(NY-KNY)
C
C---- Find start point along x
C
IF (BIGGERX) THEN
N = NDIFFX*NY/2 + N
ELSE
NP = NDIFFX*KNY/2 + NP
END IF
C
C---- Now on common x, find limits of common area
C
NCOMMONX = MIN(NX,KNX)
NCOMMONY = MIN(NY,KNY)
C
C---- Offset y ready to loop
C
IF (BIGGERY) THEN
N = N - NDIFFY/2
ELSE
NP = NP - NDIFFY/2
END IF
C
C
IF (DEBUG(22)) THEN
WRITE (IOUT,FMT=6002) NX,NY,KNX,KNY,NCOMMONX,NCOMMONY,
+ NDIFFX,NDIFFY,N,NP
WRITE (ITOUT,FMT=6002) NX,NY,KNX,KNY,NCOMMONX,NCOMMONY,
+ NDIFFX,NDIFFY,N,NP
END IF
C
C---- Loop over common x
C
DO 30 I = 1,NCOMMONX
C
C---- First find common point along y
C
IF (BIGGERY) THEN
N = N + NDIFFY
ELSE
NP = NP + NDIFFY
END IF
C
C---- Loop over common y
C
DO 20 J = 1,NCOMMONY
OD(N) = (REAL(IPROFL(NP,KBOX))/SCALE+ODMIN) + OD(N)
IFLAG(N) = IFLAG(N) + NRF
C
C
IF ((N.GT.NXY) .OR. (NP.GT.KNXY)) THEN
GO TO 70
ELSE
C
C
IF ((DEBUG(22)) .AND. (N.LT.30)) THEN
WRITE (IOUT,FMT=6006) N,NP
WRITE (ITOUT,FMT=6006) N,NP
END IF
C
C
N = N + 1
NP = NP + 1
END IF
20 CONTINUE
30 CONTINUE
END IF
40 CONTINUE
C
C---- End of loop over neighbours
C
C---- Scale reflection, divide by number of
C reflections contributing to that pixel=iflag(k) and multiply by
C average number of contributing reflections (to avoid loosing
C dynamic range)
C
SUMFLG = 0.0
DO 50 K = 1,NXY
SUMFLG = SUMFLG + IFLAG(K)
50 CONTINUE
C
SUMFLG = SUMFLG/REAL(NXY)
C
DO 60 K = 1,NXY
C
C
IF (IFLAG(K).NE.0) THEN
IOD = REAL(OD(K))*SUMFLG/REAL(IFLAG(K))
MAXOD = MAX(MAXOD,IOD)
MINOD = MIN(MINOD,IOD)
OD(K) = IOD
END IF
C
C
60 CONTINUE
C
C
IF (DEBUG(22)) THEN
WRITE (IOUT,FMT=6008) CBOXAV(JBOX),NINT(SUMFLG)
IF (ONLINE) WRITE (ITOUT,FMT=6008) CBOXAV(JBOX),NINT(SUMFLG)
MAXPIX = 0
CALL ODPLOT4(OD,NX,NY,1,MAXPIX)
WRITE (IOUT,FMT=6012)
IF (ONLINE) WRITE (ITOUT,FMT=6012)
CALL ODPLOT(IFLAG,NX,NY,1)
END IF
C
C
NRFSAVE(JBOX) = NRFSUM
NOVRLSAVE(JBOX) = NOVRLSUM
NWKSAVE(JBOX) = NWKSUM
RETURN
70 IF (ONLINE) WRITE (ITOUT,FMT=6004) N,NP
WRITE (IOUT,FMT=6004) N,NP
CALL SHUTDOWN
C
C---- Format statements
C
6000 FORMAT (1X,'Using',I4,' Reflections in BOX',I3,' to average BOX',
+ I3,' in averaging pass',I3,/1X,'SCALE=',F6.2,' ODMIN=',
+ F10.1)
6002 FORMAT (/1X,'NX,NY=',2I3,' KNX,KNY=',2I3,' NCOMMX,NCOMMY=',2I3,
+ ' NDIFFX,Y=',2I3,' START N,NP',2I4)
6004 FORMAT (1X,'In Subroutine MEANPRO, The Pixel count (N or NP)is T',
+ 'OO Large, N=',I4,' NP=',I4,/1X,'Try DEBUG Option')
6006 FORMAT (1X,'Equivalenced pair',2I4)
6008 FORMAT (1X,'Total background counts after averaging',F10.0,
+ /1X,'Average number of contributing reflections',I5,
+ /,1X,'Averaged ods',/)
6012 FORMAT (/1X,'Array IFLAG, Number of reflections contributing to ',
+ 'each pixel',/)
C
C
END
C== MEAS ==
SUBROUTINE MEAS(MAXR,LPROFILE,INTERPOL,IXSHIFT,IYSHIFT,ADDPART,
+ POSTREF,IPACK,MULTISEG,LASTREC,NEWPREF)
C ================================================================
IMPLICIT NONE
C
C ****************** New profile fitting ************************
C
C For additional debug output to sort out any problems with the
C circular buffer, set up DEBUG2 using the image number anf record
C record number, to avoid generating huge amounts of debug output.
C
C---- Reads stripes from disk file 'film' into array BA.
C Selects data for individual spots into array BB.
C As spots are completed, they are either transferred to
C subroutine SPROCESS to evaluate the integrated intensity,
C or if profile fitting is required they are written to disk
C file SPOTOD.DAT (logical)
C
C Two records are written for each reflection (by S/R PWRITE).
C The first record contains an I*4 word, which is the number
C of pixels in the measurement box,then 12 I*2 words containing:
C 1 the generate file record number packed into words 1 and 2
C 3 the spot X pixel coordinate
C 4 the spot Y pixel coordinate
C 5 The measurement box size NXX
C 6 The measurement box size NYY
C 7 The standard profile number for this spot
C 8 A flag = 0 normally
C = 1 if this is a summed partial
C = 2 If this is a summed partial but the other "half"
C of the partial has not been added in. These
C reflections will be rejected in process.
C
C 9 A flag for overloaded summed partials ONLY
C = 0 If not an overload
C = 1 if overloaded for integration only
C = 2 if overload for profile fitting only
C = 3 if overload for integration and profile fitting
C 10 A flag to indicate a "summed" partial for which the other
C half of the partial was not available
C 11-12 NOT USED
C
C The second record contains the optical densities,
C (packed into bytes for film data, but I*2 values for IP).
C
C IBUFF (passd to sprocess) contains:
C 1 Record number
C 2 X coordinate
C 3 Y coordinate
C 4 NXX box size in X
C 5 NYY box size in Y
C 6 Profile box number
C
C---- The generate file spot record number and the
C scanner coordinates of the spots generated by gensort
C are stored in IREC,IX,IY in common /GENDATA/
C
C LPROFILE is a local variable, because when meas is called from
C AUTOMATCH, we do NOT want profile fitting to be done, whereas
C when called by MOSFLM, it depends on the keyword input (but profile
C is done by default).
C
C NEWPREF True if using partials over multiple images in post-refinement
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MAXR,IXSHIFT,IYSHIFT,IPACK,LASTREC
LOGICAL INTERPOL,ADDPART,POSTREF,LPROFILE,MULTISEG,NEWPREF
C ..
C .. Scalars in Common ..
INTEGER IOD
C ..
C .. Arrays in Common ..
INTEGER*2 BBINT,BBSAVE
C ..
C .. Local Scalars ..
REAL DX,DY,XCAL,XXC,YCAL,YYC
INTEGER ACTREF,HFWX,HFWY,I,IBLK,IFULLX,IFULLY,
+ II,INDF,INDL,IP,IRECNO,IST,IST2,ISX,ISY,
+ IXX,IYY,J,K,KK,KMN,KMX,LEN,LINDF,M,M1,MINDF,
+ MINDL,MJ,NC,NNDBG,NECX,NECY,NR,NREXPX,NREXPXY,NREXPY,
+ NRR,NRX,NRY,NSP,NUMOD,NXS,NXX,NYS,NYY,PNTD,PNTR,
+ YC,NPBOX,ISTRIP,ISTRIPCUR,NFBOX,NOVR,IPST,NY,
+ NOVRP,IAREC,IR,IHKLG,IPNT,NXPRV,NYPRV,
+ NBOXPRV,NXY,IPREV,ICUR,NCURR,HX,HY,
+ IMEM,IMEMTOT,IMEMLIM,NNOPAIR,NPAIR,NWRITE,IR1,IR2
INTEGER*2 IIH,IIK,IIL
LOGICAL FULL,FULLY,NOXRIM,NOYRIM,REND,VALONGY,YFULL,OVERLOAD,
+ FIRSTOVERLOAD,OVERLOADP,FIRSTOVERLOADP,NOTEST,FIRST,
+ LALLOUT,LNOLP
LOGICAL DEBUG2,GT90,DEBUG4
integer irecg
C ..
C .. Local Arrays ..
INTEGER HW(240),IWORD(120),LRAS(5),MASK(MAXBOX,1:NNLINE-1),
+ PNTB(120),PNTC(120),REC(120),WX(240),X(120),Y(120),
+ IBOXNUM(120),IH(7),IMEMST(2),IMEMEND(2),
+ IPNTRM(120),
+ IBUFF(6),LMASK(MAXBOX,1:NNLINE-1)
INTEGER*2 BB(MAXBUFF),BB2(MAXBOX),BB3(MAXBOX),NHST(NREFLS,2),
+ NKST(NREFLS,2),NLST(NREFLS,2)
LOGICAL ADDREF(120),FIRSTPART(120)
C ..
C .. External Subroutines ..
EXTERNAL BSWAP,BSWAP2,INTERP,ODPLOT,PWRITE,
+ RDBLK,SETMASK,SPROCESS,MMTOPX,GETBOX,WRMTZ,NEWBOX,
+ XDLF_FLUSH_EVENTS
C ..
C .. External Functions ..
INTEGER INTPXL
EXTERNAL INTPXL
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,MOD
C ..
C .. Common blocks ..
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/film_no.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
integer id
common /film_num/ id
C&&*&& end_include ../inc/film_no.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
c INCLUDE '../inc/modarray.f'
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/parm2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm2.h
C---- START of include file parm2.h
C
C
C .. Scalars in common block /PARM2/ ..
REAL PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2
LOGICAL PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,PUPDATE,PKONLY,DENSE,PRFULLS,
+ DECONV
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
INTEGER IHD
C ..
C .. Common Block /PARM2/ ..
COMMON /PARM2/PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,
$ PKWDLIM3,PKWDOUTL,
$ ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2,
$ IHD(3,50),
$ PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,
+ PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,
+ PUPDATE,PKONLY,DENSE,
+ PRFULLS,DECONV
C ..
C
C
C&&*&& end_include ../inc/parm2.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/praccum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file praccum.h
C---- START of include file praccum.h
C
C
C ..
C .. Arrays in common block /PRACCUM/ ..
REAL PRDATA
C
C .. Scalars in common block /PRACCUM/ ..
LOGICAL ACCUMULATE,FIRSTPASS,SECONDPASS,THIRDPASS,FIRSTFILM,
+ NOTREAD
C ..
C .. Common Block /PRACCUM/ ..
COMMON /PRACCUM/PRDATA(4,50),ACCUMULATE,FIRSTPASS,SECONDPASS,
+ THIRDPASS,FIRSTFILM,NOTREAD
C ..
C
C
C&&*&& end_include ../inc/praccum.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/postreek.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C common block so we don't have to recalculate values of FRAC, PHIW, PHI
C for new post-refinement
C
REAL PHI,PHIW,FRAC
COMMON /POSTREEK/ PHI,PHIW,FRAC
C&&*&& end_include ../inc/postreek.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/resest.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- Start of include file resest.h
LOGICAL RESEST
COMMON/ESTIMATOR/RESEST
C&&*&& end_include ../inc/resest.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/trev.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file trev.h
C---- START of include file trev.h
C
C
C .. Scalars in Common block /TREV/ ..
INTEGER NXMAX,NYMAX
C ..
C .. Common Block /TREV/ ..
COMMON /TREV/NXMAX,NYMAX
C ..
C
C
C&&*&& end_include ../inc/trev.f
COMMON /BITS/IOD,BBSAVE(MAXBOX),BBINT(MAXBOX)
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (IDUM(1),BB(1))
EQUIVALENCE (LRAS(1),NXX), (LRAS(2),NYY)
C ..
SAVE
C .. Data statements ..
DATA NSP/120/,FIRST/.TRUE./,DEBUG2/.FALSE./
DATA DEBUG4/.FALSE./
CAL DEBUG2= .FALSE.
C ..
LALLOUT = .FALSE.
LNOLP = .FALSE.
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IR2 = 30*IPAD + 30
C
C---- Write XCEN,YCEN,NREF,MAXR to MOSFLM.OUT
C
C---- When summing partials, partials at the end of oscillation
C range will not be written to SPOTOD, only the summed partial.
C Thus only NREF-NPARTEND measurement boxes will be written to
C SPOTOD (NPARTEND is set in GENSORT and passed via /REPRT/)
C
IF (LPROFILE) WRITE (INMO) XCEN,YCEN,NREF-NPARTEND,MAXR,NPARTEND
C
C
VALONGY = (VEE .AND. (.NOT.VALONGX))
NREXPX = 0
NREXPY = 0
NREXPXY = 0
ISTRIPCUR = 0
ISTRIP = 0
NWRITE = 0
C
C
DO 10 I = 3,5
LRAS(I) = IRAS(I)
10 CONTINUE
C
C---- As peak area is extended by one pixel for interpolation, cannot
C interpolate outer pixels if the X or Y rim is less than one pixel
C
NOXRIM = (IRAS(4).LE.1)
NOYRIM = (IRAS(5).LE.1)
NNDBG = 0
C
IF (ONLINE) WRITE (ITOUT,FMT=6000)
IF (BRIEF.AND.LPROFILE) WRITE (IBRIEF,FMT=6000)
6000 FORMAT (/1X,'Collecting measurement boxes for each spot ')
C
NECX = XCEN*FACT + 0.5
NECY = YCEN*FACT + 0.5
C
NR = 1
IWORD(NSP) = 0
PNTB(NSP) = 1
C
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE(IOUT,FMT=6001) NREF,NPARTEND,MAXR,LPROFILE,INTERPOL,
+ ADDPART,POSTREF,IPACK,MULTISEG
IF (ONLINE) WRITE(ITOUT,FMT=6001) NREF,NPARTEND,MAXR,
+ LPROFILE,INTERPOL,
+ ADDPART,POSTREF,IPACK,MULTISEG
6001 FORMAT(1X,'Entering MEAS with',I6,' reflections',/,1X,
+ 'NPARTEND=',I5,' MAXR=',I5,' LPROFILE:',L1,
+ ' INTERPOL:',L1,' ADDPART:',L1,' POSTREF:',L1,
+ ' IPACK=',I4,' MULTISEG:',L1)
END IF
C
C Initialise LASTREC for partial summation
LASTREC = 0
C
C---- If not profile fitting, or if using SPROCESS to evaluate intensities
C for post refinement, call SPROCESS to initialise variables for
C statistics. Note that when simply adding partials over adjacent
C images (ADDPART) (without postrefinement) we do not need to call
C SPROCESS
C
I = 0
C
C *****************************
IF ((.NOT.LPROFILE).OR.POSTREF)
+ CALL SPROCESS(I,IBUFF,ADDPART,POSTREF,newpref)
C *****************************
C
C
C---- Get information on nsp=120 spots from sort file
C
DO 40 M = 1,NSP
C
C---- Reads next reflection from list output by gensort
C Note that we are now working forwards through image file.
C Previous versions of MOSFLM worked backwards here.
C
X(M) = IX(NR)
Y(M) = IY(NR)
REC(M) = IREC(NR)
C
C---- Set flag for partial summation, FIRSTPART for the first of a
C partial pair, ADDREF for the second
C
ADDREF(M) = (ABS(IREC(NR)).EQ.LASTREC)
FIRSTPART(M) = (ABS(IREC(NR)).EQ.ABS(IREC(NR+1)))
LASTREC = ABS(IREC(NR))
C
FULLY = (REC(M).GT.0)
C
C---- If measuring an expanded list for automatch, set the
C record number to the reflection number in the sorted list
C
IF (MATCH) THEN
IF (FULLY) THEN
NRR = NR
ELSE
NRR = -NR
END IF
C
C
REC(M) = NRR
END IF
C
C
REND = (NR.EQ.NREF)
NR = NR + 1
IF (MOD(NR,300).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
CAL DEBUG2 = ((NR.GT.2700).AND.(IPACK.EQ.4))
C
C---- Get the raster parameters and box number for this reflection
C
C ***********************************
IF ((X(M).EQ.0).AND.(Y(M).EQ.0)) WRITE(6,*)'ZERO X,Y AT NR,M',
+ NR,M
CALL GETBOX(X(M),Y(M),NXX,NYY,NPBOX)
C ***********************************
IBOXNUM(M) = NPBOX
C
32 HFWX = NXX/2
HFWY = NYY/2
HW(2*M-1) = HFWX
HW(2*M) = HFWY
C
C
C
C
WX(M) = NXX
IF (IMGP) THEN
IWORD(M) = NXX*NYY + 12
ELSE
IWORD(M) = (NXX*NYY+1)/2 + 12
END IF
M1 = M - 1
IF (M.EQ.1) M1 = NSP
PNTB(M) = PNTB(M1) + IWORD(M1)
IF (PNTB(M)+IWORD(M).GT.MAXBUFF) PNTB(M) = 1
PNTC(M) = PNTB(M)
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE (IOUT,FMT=6016) NR-1,M,X(M),Y(M),REC(M),NXX,NYY,
+ NPBOX,IR,PNTB(M)
IF (ONLINE) WRITE (ITOUT,FMT=6016) NR-1,M,X(M),Y(M),
+ REC(M),NXX,NYY,NPBOX,IR,PNTB(M)
NNDBG = NNDBG + 1
END IF
6016 FORMAT (1X,'New NR=',I4,' M=',I4,5X,'Pixel ',
+ 'coords',2I6,' IREC',I6,' Raster box size',2I5,
+ ' Profile number',I3,' IR',I3,' PNTB',I6)
C
C---- Apply box shift
C
X(M) = X(M) + IXSHIFT
Y(M) = Y(M) + IYSHIFT
IF (REND) GOTO 42
40 CONTINUE
C
C---- PNTB,PNTC
C these are markers in bb to show where it is filled
C PNTB(MJ) stores the pointer to the first word for spot MJ.
C PNTC(MJ) stores the pointer to the current position of spot MJ,
C ie it starts as PNTB and is incremented by NY for each
C stripe of data read in.
C
C---- INDF,INDL:-
C show which reflections are active in sorted file of NREF reflections
C INDF is incremented when a reflection is written to SPOTOD
C MINDF,MINDL
C are active reflections in the buffer BB,
C ie INDF MOD(NSP) and INDL MOD(NSP) so they run from 1 to NSP
C
42 INDF = 1
LINDF = INDF
INDL = 1
MINDF = 1
ACTREF = 0
YFULL = .FALSE.
FULL = .FALSE.
C
C---- Start scan for the first spot or spot after a gap
C
50 IBLK = X(MINDF) - HW(2*MINDF-1)
C
C---- Include the spot in this scan
C
C ****************
60 CALL RDBLK(IBLK)
C ****************
C
70 IF (INDL.EQ.NREF) GO TO 100
CAL****
CAL DEBUG(17) = DEBUG2
CAL****
IF (FULL) GO TO 100
C
C---- Note that MINDL is one reflection AHEAD of INDL, so that if
C reflection MINDL fills up the buffer, it is still OK
C to process spots up to INDL
C
MINDL = MOD(INDL,NSP) + 1
IF (IBLK.LT.X(MINDL)-HW(2*MINDL-1)) GO TO 100
IF (INDL-INDF.GE.NSP-1) GO TO 80
IF (MINDL.EQ.MINDF) GO TO 90
PNTD = PNTB(MINDL) - PNTB(MINDF)
IF (DEBUG2) THEN
GT90 = (PNTD.GT.0 .OR. PNTD.LT.-IWORD(MINDL))
WRITE(IOUT,FMT=7003) NR,MINDF,PNTB(MINDF),MINDL,PNTB(MINDL),
+ PNTD,GT90,FULL
IF (ONLINE) WRITE(ITOUT,FMT=7003) NR,MINDF,PNTB(MINDF),
+ MINDL,PNTB(MINDL),PNTD,GT90,FULL
7003 FORMAT(1X,'NR=',I6,' First spot',I4,' Pointer',I8,5x,
+ 'Second spot',I4,' Pointer',I8,' PNTD=',I6,
+ ' GOTO 90',L2,' FULL',L2)
END IF
C
C---- Need to trap case where MINDF is very near end of buffer and
C the new spot (MINDL) has a start point below MINDF but also has
C a larger box than MINDF so that it would extend beyond the buffer so
C PNTB has been reset to 1. Also ensure that MINDL is not the next
C spot after MINDF.
C
IF (((MAXBUFF-PNTB(MINDF)).LT.IWORD(MINDL)).AND.
+ (PNTB(MINDL).EQ.1).AND.(ABS(MINDL-MINDF).GT.1)) THEN
CAL + (PNTB(MINDL).EQ.1).AND.((MINDL-MINDF).GT.1)) THEN
WRITE(IOUT,FMT=7003) NR,MINDF,PNTB(MINDF),MINDL,PNTB(MINDL),
+ PNTD,GT90,FULL
IF (ONLINE) WRITE(ITOUT,FMT=7003) NR,MINDF,PNTB(MINDF),
+ MINDL,PNTB(MINDL),PNTD,GT90,FULL
WRITE(IOUT,FMT=7006)
IF (ONLINE) WRITE(ITOUT,FMT=7006)
7006 FORMAT(1X,'Buffer set full')
GOTO 80
END IF
IF (PNTD.GT.0 .OR. PNTD.LT.-IWORD(MINDL)) GO TO 90
80 YFULL = .TRUE.
FULL = .TRUE.
IF (DEBUG(17)) THEN
WRITE(IOUT,FMT=7008) INDF,INDL,MINDF,MINDL
IF (ONLINE) WRITE(ITOUT,FMT=7008) INDF,INDL,MINDF,MINDL
7008 FORMAT(1X,'*** buffer is full ***, INDF=',I5,' INDL=',I5,
+ ' MINDF=',I4,' MINDL=',I4)
END IF
C
C---- Must not let buffer be set full when the last reflection is the
C first part of a summed partial (or one to be used in post-refinement)
C because we need the pixel values for both halves to be stored in BB
C at the same time for testing overloaded pixels. Thus if the last
C reflection is the first part of a summed partial, decrease INDL by 1.
C
M1 = MINDL - 1
IF (M1.EQ.0) M1 = NSP
IF (FIRSTPART(M1)) THEN
INDL = INDL - 1
MINDL = MOD(INDL,NSP) + 1
IF (DEBUG(17)) THEN
WRITE(IOUT,FMT=7010) INDL
IF (ONLINE) WRITE(ITOUT,FMT=7010) INDL
7010 FORMAT(1X,'** INDL DECREASED BY ONE, NEW VALUE',I6)
END IF
END IF
GO TO 70
90 INDL = INDL + 1
C****
CAL DEBUG2 = (INDL.GT.6000)
C****
GO TO 70
100 CONTINUE
C
C---- Get the information for this scan and start a new one
C
C---- Store pixel values for active spots in this stripe in array BB
C
DO 120 J = INDF,INDL
MJ = MOD(J-1,NSP) + 1
YC = Y(MJ)
KMN = YC - HW(2*MJ)
KMX = HW(2*MJ) + YC
C
PNTR = PNTC(MJ)
C
C---- PNTR is used as word pointer then changed to byte pointer
C
C---- Store the record number, pixel X and Y coordinates, measurement box size,
C standard profile number and summed partial flag for this spot in BB
C
IF (PNTR.NE.PNTB(MJ)) GO TO 110
C
C---- Pack record number into first two I*2 words
C
CALL RECPACK(BB(PNTR),REC(MJ))
IF (DEBUG2) THEN
WRITE(IOUT,FMT=7001) MJ,REC(MJ),PNTR,IWORD(MJ),BB(PNTR)
IF (ONLINE) WRITE(ITOUT,FMT=7001) MJ,REC(MJ),PNTR,
+ IWORD(MJ),BB(PNTR)
7001 FORMAT(1X,'MJ=',I5,' Storing irecg=',I6,' at PNTR=',I10,
+ ' IWORD=',I6,' BB=',I12)
END IF
CAL BB(PNTR) = REC(MJ)
C
C---- Subtract box shift before storing this
C
BB(PNTR+2) = X(MJ) - IXSHIFT
BB(PNTR+3) = YC - IYSHIFT
C
C---- Multiply both bytes by 2 after adding 1
C
IFULLX = HW(2*MJ-1)*2 + 1
IFULLY = HW(2*MJ)*2 + 1
BB(PNTR+4) = IFULLX
BB(PNTR+5) = IFULLY
BB(PNTR+6) = IBOXNUM(MJ)
IF (ADDREF(MJ)) THEN
BB(PNTR+7) = 1
ELSE
BB(PNTR+7) = 0
END IF
BB(PNTR+8) = 0
BB(PNTR+9) = 0
BB(PNTR+10) = 0
BB(PNTR+11) = 0
C
C Change PNTR to a byte pointer for film data (stored as bytes) but
C keep as word pointer for image plates (stored as I*2)
C Allow space for 12 words to be stored about this reflection (See comments
C at head of subroutine
C
IF (IMGP) THEN
PNTR = PNTR + 12
ELSE
PNTR = 2*PNTR + 23
END IF
110 CONTINUE
C
C---- *** NOTE WELL: PNTR is updated in call to BSWAP
C
C *******************
CALL BSWAP(KMN,KMX,PNTR)
C *******************
C
C If this is a partial to be summed from the next image, add in the
C pixel values for the second image
C
IF (ADDREF(MJ)) THEN
C
C Reset PNTR (incremented in BSWAP)
PNTR = PNTR - (KMX - KMN + 1)
C
C---- *** NOTE WELL: PNTR is updated in call to BSWAP2
C
C *******************
CALL BSWAP2(KMN,KMX,PNTR)
C *******************
END IF
C
PNTC(MJ) = PNTR
WX(MJ) = WX(MJ) - 1
120 CONTINUE
C
C
IF (INDL-INDF+1.GT.ACTREF) ACTREF = INDL - INDF + 1
IBLK = IBLK + 1
C
C---- See if spot is finished
C
130 IF (WX(MINDF).EQ.0) GO TO 170
C
C---- Read new spots for those completed on this stripe
C
140 IF (LINDF.EQ.INDF) GO TO 160
M = MOD(LINDF-1,NSP) + 1
IF (REND) GO TO 150
C
C---- Reads next reflection from list output by gensort
C Note that we are now working forwards through image file.
C Previous versions of MOSFLM worked backwards here.
C
X(M) = IX(NR)
Y(M) = IY(NR)
REC(M) = IREC(NR)
FULLY = (REC(M).GT.0)
C
C Set flags for partial summation
ADDREF(M) = (ABS(IREC(NR)).EQ.LASTREC)
C
C
IF (NR.GT.1) DEBUG4 = (ABS(IREC(NR)).EQ.ABS(IREC(NR-1)))
IF (ADDREF(M).AND.(.NOT.DEBUG4)) THEN
WRITE(6,*)'Conflict at NR,M,LASTREC,IREC(NR-1),IRECNR',
+ NR,M,LASTREC,IREC(NR-1),IREC(NR)
STOP
END IF
FIRSTPART(M) = (ABS(IREC(NR)).EQ.ABS(IREC(NR+1)))
LASTREC = ABS(IREC(NR))
C
C---- If measuring an expanded list for automatch, set the
C record number to the reflection number in the sorted list
C
IF (MATCH) THEN
IF (FULLY) THEN
NRR = NR
ELSE
NRR = -NR
END IF
C
C
REC(M) = NRR
END IF
C
C
REND = (NR.EQ.NREF)
NR = NR + 1
IF (MOD(NR,300).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
CAL***
CAL DEBUG2 = ((NR.GT.2700).AND.(IPACK.EQ.4))
C
C---- Get the raster parameters and box number for this reflection
C
C ***********************************
IF ((X(M).EQ.0).AND.(Y(M).EQ.0)) WRITE(6,*)'ZERO X,Y AT NR,M',
+ NR,M
CALL GETBOX(X(M),Y(M),NXX,NYY,NPBOX)
C ***********************************
IBOXNUM(M) = NPBOX
C
144 HFWX = NXX/2
HFWY = NYY/2
HW(2*M-1) = HFWX
HW(2*M) = HFWY
C
C
C
C
WX(M) = NXX
IF (IMGP) THEN
IWORD(M) = NXX*NYY + 12
ELSE
IWORD(M) = (NXX*NYY+1)/2 + 12
END IF
M1 = M - 1
IF (M.EQ.1) M1 = NSP
PNTB(M) = PNTB(M1) + IWORD(M1)
IF (PNTB(M)+IWORD(M).GT.MAXBUFF) PNTB(M) = 1
PNTC(M) = PNTB(M)
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE (IOUT,FMT=6016) NR-1,M,X(M),Y(M),REC(M),NXX,NYY,
+ NPBOX,IR,PNTB(M)
IF (ONLINE) WRITE (ITOUT,FMT=6016) NR-1,M,X(M),Y(M),
+ REC(M),NXX,NYY,NPBOX,IR,PNTB(M)
NNDBG = NNDBG + 1
END IF
C
C---- Apply box shift
C
X(M) = X(M) + IXSHIFT
Y(M) = Y(M) + IYSHIFT
150 LINDF = LINDF + 1
GO TO 140
160 IF (INDF.LE.INDL) GO TO 60
IF (DEBUG2) THEN
WRITE(IOUT,FMT=7004) INDF,INDL,MINDF,MINDL,LINDF
IF (ONLINE) WRITE(ITOUT,FMT=7004) INDF,INDL,MINDF,MINDL,LINDF
7004 FORMAT(1X,'*** full = false ***, indf=',I5,' INDL=',I5,
+ 'MINDF=',I4,' mindl=',I4,' lindf=',I4)
END IF
FULL = .FALSE.
GO TO 50
C
C---- Write out completed spots to mosflm.out (unit inmo)
C and read in new ones
C
170 LEN = IWORD(MINDF) - 12
IST = PNTB(MINDF)
C
171 IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
NXX = HW(2*MINDF-1)*2 + 1
NYY = HW(2*MINDF)*2 + 1
CALL RECUNPACK(BB(IST),IRECNO)
WRITE (IOUT,FMT=6018) MINDF,NXX,NYY,IRECNO,
+ (BB(KK),KK=IST+2,IST+3),BB(IST+6),IST
IF (ONLINE) WRITE (ITOUT,FMT=6018) MINDF,NXX,NYY,IRECNO,
+ (BB(KK),KK=IST+2,IST+3),BB(IST+6),IST
6018 FORMAT(//1X,'Finished reflection',I6,' Raster size ',2I3,
+ ' IREC',
+ I6,' Pixel coords',2I6,' Profile number',I3,' IST',I6)
IF (ADDREF(MINDF)) THEN
WRITE(IOUT,6019)
IF (ONLINE) WRITE(ITOUT,6019)
END IF
6019 FORMAT(1X,'** This is a summed partial **')
IF (SPOT) CALL ODPLOT(BB(IST+12),NXX,NYY,1)
END IF
C
C---- If profile fitting, write spot ods to mosflm.out
C otherwise, transfer ods to boxod in /pel/ in order to
C transfer them to "sprocess"
C
IF (LPROFILE) THEN
C
C---- Test for change of nxx for setting masks
C
NXX = HW(2*MINDF-1)*2 + 1
NYY = HW(2*MINDF)*2 + 1
NPBOX = IBOXNUM(MINDF)
CALL GETSTRIP(NPBOX,ISTRIP)
IF (ISTRIP.EQ.ISTRIPCUR) GO TO 220
C
C
ISTRIPCUR = ISTRIP
NFBOX = NPFIRST(ISTRIP) - 1
IF (DEBUG(17)) THEN
WRITE (IOUT,FMT=6002) ISTRIP,NFBOX+1
6002 FORMAT (1X,'In MEAS setting up new MASKS at',
+ ' ISTRIP=',I3,' NFBOX=',I3)
IF (ONLINE) WRITE (ITOUT,FMT=6002) ISTRIP,NFBOX+1
END IF
C
C---- Set up the masks for this strip (needed for interpolation)
C
DO 200 K = 1,NYLINE-1
NFBOX = NFBOX + 1
C
C---- Skip if not a valid box
C
IF (.NOT.BOX(NFBOX)) GOTO 200
NYY = ISIZE(NFBOX,2)
C
C ***********************
CALL SETMASK(MASK(1,K),LRAS)
C ***********************
C
C---- Now set up a mask to be used in interpolation where any pixel adjacent
C to a peak pixel is flagged as a peak pixel, because only peak pixels
C are actually interpolated.
C
HX = NXX/2
HY = NYY/2
CALL NEWMASK(MASK(1,K),LMASK(1,K),NXX,NYY,HX,HY)
C
200 CONTINUE
C
C
NYY = HW(2*MINDF)*2 + 1
C
C---- Set index for correct mask. First get box number then get the Y
C index
C
220 NPBOX = IBOXNUM(MINDF)
CALL GETYIND(NPBOX,NY)
C
C Check if it has any overloaded pixels.
C Do this now if either
C 1) No post-refinement is bing done and this is NOT a summed
C partial (this special case is dealt with below)
C or
C 2) If we are doing post-refinement but this is not a partial
C (neither the first half or the summed partial). In this case
C the test is done when the pixels are being transferred to
C BOXOD ready for integration.
C
C For the test for inclusion in profiles
C test all pixels in box, for integration, only peak pixels.
C
C
OVERLOAD = .FALSE.
OVERLOADP = .FALSE.
IF (((.NOT.POSTREF).AND.(.NOT.ADDREF(MINDF))).OR.
+ (POSTREF.AND.(.NOT.FIRSTPART(MINDF)).AND.
+ (.NOT.ADDREF(MINDF))))
+ THEN
NOVR = 0
NOVRP = 0
DO 172 I = 1,LEN
KK = IST + 11 + I
IF ((INTPXL(BB(KK)).GT.CUTOFF).AND.(MASK(I,NY).GT.0))
+ NOVR = NOVR + 1
IF (INTPXL(BB(KK)).GT.PRCUTOFF) NOVRP = NOVRP + 1
172 CONTINUE
IF (FIRSTPART(MINDF)) THEN
FIRSTOVERLOAD = (NOVR.GT.NOVPIX)
FIRSTOVERLOADP = (NOVRP.GT.NOVPIX)
END IF
OVERLOAD = (NOVR.GT.NOVPIX)
OVERLOADP = (NOVRP.GT.NOVPIX)
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE(IOUT,FMT=6023) NOVR,FIRSTPART(MINDF),
+ ADDREF(MINDF),OVERLOAD
IF (ONLINE) WRITE(ITOUT,FMT=6023) NOVR,FIRSTPART(MINDF),
+ ADDREF(MINDF),OVERLOAD
END IF
END IF
C
C---- If this is the second (ie summed) half of a summed partial,
C set up the pointer to the start of the pixel values of the first
C half of this partial, need for overload test below
C This assumes the summed partial always follows immediatley after
C the first half
C
IF (ADDREF(MINDF)) THEN
IPOINT = MINDF - 1
IF (IPOINT.LT.1) IPOINT = NSP
IPST = PNTB(IPOINT) + 12 -1
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE(IOUT,FMT=6021) IPST-11
IF (ONLINE) WRITE(ITOUT,FMT=6021) IPST-11
END IF
6021 FORMAT(1X,'Pointer to first half of this reflection',I6)
END IF
C
C---- Now check second (summed) half of summed partial when not doing
C post refinement (otherwise this is done below)
C
IF ((.NOT.POSTREF).AND.ADDREF(MINDF)) THEN
NOVR = 0
NOVRP = 0
C
C---- Dont need to test summed partial if flagged as integration and profile
C overload on first half of summed partial
C
NOTEST = ((FIRSTOVERLOAD).AND.(FIRSTOVERLOADP))
IF (.NOT.NOTEST) THEN
DO 173 I = 1,LEN
KK = IST + 11 + I
IOD = INTPXL(BB(KK)) - INTPXL(BB(IPST+I))
IF ((IOD.GT.CUTOFF).AND.(MASK(I,NY).GT.0))
+ NOVR = NOVR + 1
IF (IOD.GT.PRCUTOFF) NOVRP = NOVRP + 1
173 CONTINUE
OVERLOAD = (NOVR.GT.NOVPIX)
OVERLOADP = (NOVRP.GT.NOVPIX)
END IF
C
C---- If either integration or profile overload on first half, then
C overload flag must be set, regardless of second half.
C
IF (FIRSTOVERLOAD) THEN
OVERLOAD = .TRUE.
FIRSTOVERLOAD = .FALSE.
END IF
IF (FIRSTOVERLOADP) THEN
OVERLOADP = .TRUE.
FIRSTOVERLOADP = .FALSE.
END IF
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE(IOUT,FMT=6023) NOVR,FIRSTPART(MINDF),
+ ADDREF(MINDF),OVERLOAD
IF (ONLINE) WRITE(ITOUT,FMT=6023) NOVR,FIRSTPART(MINDF),
+ ADDREF(MINDF),OVERLOAD
END IF
END IF
C
C---- If running postrefinement, integrate pairs of partials here
C In old postrefinement, will integrate if this is the first part
C of a partial over 2 images (FIRSTPART) or if this is the
C a summed partial over two images (ADDREF). With NEWPREF,
C need to call this for all partials, as the reflection is
C allowed to extend over many images.
C
IF (POSTREF.AND.
+ ((FIRSTPART(MINDF).OR.ADDREF(MINDF)).OR.NEWPREF)) THEN
CALL RECUNPACK(BB(IST),IRECNO)
IBUFF(1) = IRECNO
IP = IST + 1
DO 174 II = 2,6
IP = IP + 1
IBUFF(II) = BB(IP)
174 CONTINUE
C
C---- Skip 5 other words of header in BB (not needed)
C
IP = IP + 5
NOVR = 0
NOVRP = 0
C
C---- Transfer pixel values
C
DO 176 NUMOD = 1,LEN
IP = IP + 1
BOXOD(NUMOD) = BB(IP)
C
C---- Trap overloads on first half of a summed partial
C
IF (FIRSTPART(MINDF)) THEN
IF ((INTPXL(BOXOD(NUMOD)).GT.CUTOFF).AND.
+ (MASK(NUMOD,NY).GT.0)) NOVR = NOVR + 1
IF (INTPXL(BOXOD(NUMOD)).GT.PRCUTOFF)
+ NOVRP = NOVRP + 1
C
C---- Trap overloads on second (summed) half of a summed partial.
C To do this we must first subtract the pixel value of the first
C part of the summed partial and test the result !
C Don't bother to do this if the first half was overloaded
C (flagged by FIRSTOVERLOAD)
C
ELSE IF (ADDREF(MINDF).AND.(.NOT.FIRSTOVERLOAD)) THEN
IOD = INTPXL(BOXOD(NUMOD)) - INTPXL(BB(IPST+NUMOD))
IF ((IOD.GT.CUTOFF).AND.(MASK(NUMOD,NY).GT.0))
+ NOVR = NOVR + 1
IF (IOD.GT.PRCUTOFF) NOVRP = NOVRP + 1
END IF
176 CONTINUE
C
C---- Set overload flag
C
OVERLOAD = (NOVR.GT.NOVPIX)
OVERLOADP = (NOVRP.GT.NOVPIX)
C
C---- If this is the first part of a summed partial, must set a flag so
C that even if the second half does NOT contain any overloaded pixels
C the summed reflection still gets flagged as an overload
C
IF (FIRSTPART(MINDF).AND.OVERLOAD) FIRSTOVERLOAD = .TRUE.
IF (FIRSTPART(MINDF).AND.OVERLOADP) FIRSTOVERLOADP = .TRUE.
C
IF (ADDREF(MINDF).AND.FIRSTOVERLOAD) THEN
OVERLOAD = .TRUE.
FIRSTOVERLOAD = .FALSE.
END IF
IF (ADDREF(MINDF).AND.FIRSTOVERLOADP) THEN
OVERLOADP = .TRUE.
FIRSTOVERLOADP = .FALSE.
END IF
C
IF (DEBUG(17).AND.(NNDBG.LT.NDEBUG(17))) THEN
WRITE(IOUT,FMT=6023) NOVR,FIRSTPART(MINDF),
+ ADDREF(MINDF),OVERLOAD
IF (ONLINE) WRITE(ITOUT,FMT=6023) NOVR,FIRSTPART(MINDF),
+ ADDREF(MINDF),OVERLOAD
6023 FORMAT(1X,'Number of overloads',I5,'First half of',
+ ' summed partial ',L1,' second summed half ',L1,
+ ' OVERLOAD ',L1)
END IF
C
C ***********************************
CALL SPROCESS(LEN,IBUFF,ADDPART,POSTREF,newpref)
C ***********************************
C
END IF
if((debug(17)).and.(irecno.gt.0).AND.(NNDBG.LT.NDEBUG(17))) then
write(iout,1753)phiwg(irecno),id,phig(irecno),xg(irecno),
+ yg(irecno),IHG(irecno),IKG(irecno),ILG(irecno),
+ irg(irecno),intg(irecno),isdg(irecno),fracg(irecno)
if (online)
+ write(itout,1753)phiwg(irecno),id,phig(irecno),
+ xg(irecno), yg(irecno),IHG(irecno),IKG(irecno),
+ ILG(irecno), irg(irecno),intg(irecno),isdg(irecno),
+ fracg(irecno)
1753 format('PhiW = ',f8.4,', Film ',i3,
+ ' Phi = ',f8.4,', X, Y = ',2F12.4,
+ ', HKL = ',3I4,' MPART = ',
+ I6,' I, sig(I) = ',2I6,', fraction = ',f8.5)
endif
C
C---- If this is the first part of an added partial, there is no need
C to write it to the SPOTOD file as the summed partial itself will be
C integrated. However in POSTHOC we still need to interpolate these
C reflections onto the calculated position, so do not jump yet.
C
178 IF (ADDPART.AND.FIRSTPART(MINDF)) GOTO 250
C
C
C---- Similarly, if NOT adding partials, there is no need to write the
C SUMMED partial to the SPOTOD file.
C
IF ((.NOT.ADDPART).AND.ADDREF(MINDF)) GOTO 250
C
C---- Also, if doing multisegment post-refinement, do not need spotod file
C because images are not integrated
C
IF (MULTISEG) GOTO 250
C
C---- Now transfer all bytes into BBINT
C
IST2 = IST + 11
C
C
DO 180 I = 1,LEN
BBINT(I) = BB(I+IST2)
180 CONTINUE
C
C---- Allow for interpolation of optical densities (in peak area only)
C this requires setting up masks
C
IF (INTERPOL) THEN
C
C---- Transfer all bytes into bbsave to use in interpolation
C
DO 190 I = 1,LEN
BBSAVE(I) = BBINT(I)
190 CONTINUE
C
C---- Calculate fractional error in spot coordinates due to
C rounding to nearest scanner pixel
C
CALL RECUNPACK(BB(IST),IRECNO)
IF (IRECNO.GT.NREFLS) THEN
WRITE(IOUT,FMT=7000) IST,IRECNO,LEN
IF (ONLINE) WRITE(ITOUT,FMT=7000) IST,IRECNO,LEN
7000 FORMAT(1X,'IST',I12,' IRECNO',I12,' LEN',I6)
DX = -1.0
DX = SQRT(DX)
END IF
IRECNO = ABS(IRECNO)
CAL IRECNO = ABS(BB(IST))
IXX = BB(IST+2)
IYY = BB(IST+3)
XXC = XG(IRECNO)
YYC = YG(IRECNO)
C
C *************************
CALL MMTOPX(XCAL,YCAL,XXC,YYC)
C *************************
C
C---- Note sign of dx is due to the fact that we are working
C from left to right on film image in this s/r.
C
DX = - (IXX-XCAL*FACT)
DY = - (IYY-YCAL*FACT)
ISX = 1
C
C
IF (DX.LT.0.0) THEN
ISX = -1
DX = ABS(DX)
END IF
C
C
ISY = 1
C
C
IF (DY.LT.0.0) THEN
ISY = -1
DY = ABS(DY)
END IF
C
C---- Set index for correct mask. First get box number then get the Y
C index
C
NPBOX = IBOXNUM(MINDF)
CALL GETYIND(NPBOX,K)
C
C
IF (DEBUG(17) .AND. (NNDBG.LT.NDEBUG(17))) THEN
WRITE (IOUT,FMT=6006) IRECNO,IXX,IYY,XXC,YYC,DX,DY,ISX,
+ ISY,XCAL*FACT,YCAL*FACT,NXX,NYY,K,OVERLOAD
6006 FORMAT (1X,'RECORD',I5,' SCANNER X,Y',2I6,' GENFILE X,Y',
+ 2F8.1, /,1X,' DX,DY',2F5.2,' ISX,ISY',2I3,' X,Y',
+ 2F7.1,' NXX,NYY,K',3I4,' OVERLOAD ',L1)
IF (ONLINE) WRITE (ITOUT,FMT=6006) IRECNO,IXX,IYY,XXC,YYC,
+ DX,DY,ISX,ISY,XCAL*FACT,YCAL*FACT,NXX,NYY,K,OVERLOAD
END IF
C
C---- Do not interpolate overloaded reflections, or if shift to
C calculated pixel is less than 0.1 pixels. Note use of LMASK
C which has had the peak area extended by one pixel in the
C interpolation
C
IF (((DX.GT.0.1).OR.(DY.GT.0.1)).AND.(.NOT.OVERLOAD))
C **************************
+ CALL INTERP(LMASK(1,K),NXX,
+ NYY,DX,DY,ISX,ISY,NOXRIM,
+ NOYRIM,LEN)
C **************************
IF (DEBUG(17).AND.SPOT.AND.(NNDBG.LT.NDEBUG(17))) THEN
C
WRITE (IOUT,FMT=6020)
IF (ONLINE) WRITE (ITOUT,FMT=6020)
6020 FORMAT(/1X,'After interpolation')
C ***********************************
CALL ODPLOT(BBINT(1),NXX,NYY,1)
C ***********************************
C
END IF
END IF
C
C---- End of "IF INTERPOL" block
C
C---- Set "overload" flag if overloaded:
C = 1 if overloaded for integration but not profile fitting
C = 2 if overloaded for profile fitting but not integration
C = 3 if overloaded for both
C
192 IF (OVERLOAD.AND.(.NOT.OVERLOADP)) THEN
BB(IST+8) = 1
ELSE IF (OVERLOADP.AND.(.NOT.OVERLOAD)) THEN
BB(IST+8) = 2
ELSE IF (OVERLOADP.AND.OVERLOAD) THEN
BB(IST+8) = 3
END IF
C
C
C ******************************
CALL PWRITE(BB(IST),BBINT,LEN,INMO)
NWRITE = NWRITE + 1
C ******************************
C
ELSE
C
C---- For integrated intensities only
C
C
CALL RECUNPACK(BB(IST),IRECNO)
IBUFF(1) = IRECNO
IP = IST + 1
C
DO 230 II = 2,6
IP = IP + 1
IBUFF(II) = BB(IP)
230 CONTINUE
C
C
C---- Skip 5 other words of headr in BB (not needed)
C
IP = IP + 5
C
C---- Transfer pixel values
C
C
DO 240 NUMOD = 1,LEN
IP = IP + 1
BOXOD(NUMOD) = BB(IP)
240 CONTINUE
C
C ***********************************
CALL SPROCESS(LEN,IBUFF,ADDPART,POSTREF,newpref)
C ***********************************
C
END IF
C
C
C---- Update pointer to first active reflection
C
250 INDF = INDF + 1
MINDF = MOD(INDF-1,NSP) + 1
IF (INDF.LE.NREF) GO TO 130
C
C ***************************************************
C---- All reflections now integrated or written to SPOTOD
C ***************************************************
C
C
CAL IF (YFULL) WRITE (IOUT,FMT=6008)
6008 FORMAT (' Buffer was FULL')
WRITE (IOUT,FMT=6010) ACTREF
6010 FORMAT (/2X,'MAX. No. of Active Reflections=',I6)
IF (LPROFILE) WRITE (IOUT,FMT=6014) NREF-NPARTEND
6014 FORMAT (I6,' Reflections written to scratch file for integration')
IF ((NREXPX.NE.0) .OR. (NREXPY.NE.0) .OR.
+ (NREXPXY.NE.0)) WRITE (IOUT,FMT=6012) NREXPX,NREXPY,NREXPXY
6012 FORMAT (/1X,'****** WARNING ******',/1X,'Suppresion of raster ex',
+ 'pansion in X direction has been applied to',I5,' Reflect',
+ 'ions',/1X,'in the Y direction to',I6,' Reflections',/1X,
+ 'and in both X and Y to',I5,' Reflections')
C
C
IF (ONLINE) THEN
C
CAL IF (YFULL) WRITE (ITOUT,FMT=6008)
WRITE (ITOUT,FMT=6010) ACTREF
IF (LPROFILE) WRITE (ITOUT,FMT=6014) NREF-NPARTEND
IF (BRIEF.AND.LPROFILE) WRITE (IBRIEF,FMT=6014) NREF-NPARTEND
IF ((NREXPX.NE.0) .OR. (NREXPY.NE.0) .OR.
+ (NREXPXY.NE.0)) WRITE (ITOUT,FMT=6012)
+ NREXPX,NREXPY,NREXPXY
END IF
C
C---- If not profile fitting, make final call to sprocess
C
IF (.NOT.LPROFILE) THEN
C
C---- If running automatch, return here
C
IF (MATCH.and..not.resest) RETURN
LEN = 1
C
C ***********************************
CALL SPROCESS(LEN,IBUFF,ADDPART,POSTREF,newpref)
if(resest)return
C ***********************************
STHCUT = 0.0
CALL WRMTZ(IPACK,ADDPART,NEWPREF,LALLOUT,LNOLP)
C
ELSE
C
C---- Do not rewind mosflm.out if this is the firstpass
C accumulating profiles
C
IF (.NOT.FIRSTPASS) REWIND INMO
END IF
C
RETURN
END
SUBROUTINE MENKW(NEWWIN,LHELP,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST)
C ======================================================
C
C---- Read keyword input by calling CONTROL
C
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
INTEGER IFIRSTPACK
LOGICAL NEWWIN,LHELP,NEWGENF,GENOPEN,RPTFIRST
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,IXM,IYM,LINELEN,NUMLIN,MODECTRL,ICOLR
REAL RX,RY,DISTANCE
LOGICAL FIRSTTIME
CHARACTER STR*100,LINE*80,CELLSTR*50
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL MXDCIO,XDLF_FLUSH_EVENTS,MXDWIO,CONTROL,DSPCIRC
C ..
C .. Intrinsic Functions ..
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Common blocks ..
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
C Create IO window
C
LINE = ' '
IF (NEWWIN) THEN
IXM = 200
IYM = 200
LINELEN = 79
NUMLIN= 10
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
END IF
C
IF (LHELP) THEN
LINE = 'Give keyworded input at the MOSFLM prompt.'
CALL MXDWIO(LINE,1)
LINE = 'Terminate input by typing END or GO.'
CALL MXDWIO(LINE,3)
END IF
CALL XDLF_FLUSH_EVENTS(I)
MODECTRL = 3
FIRSTTIME = .FALSE.
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
C
C---- In case DISTANCE has been input by keyword, need to reset it
C
DISTANCE = 0.01*XTOFD
C
C---- Delete and redraw backstop shadow circle in case it has changed
C
CALL MXDDVN(CIRC_VEC)
ICOLR = 1
IF ((RMINX.NE.0.0).AND.(RMINY.NE.0.0)) THEN
RX = 0.01*RMINX
RY = 0.01*RMINY
ELSE
RX = 0.01*XCEN
RY = 0.01*YCEN
END IF
CALL DSPCIRC(RX,RY,0.01*RMIN,ICOLR)
IF (NEWWIN) CALL MXDCIO(1,0,0,0,0)
END
SUBROUTINE MENSAVE(AUTOIND,NEWSPOTS)
C ====================================
C
C---- Saves found spots to a file. This is done "silently" if part of
C autoindexing, otherwise asks for a filename.
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
LOGICAL AUTOIND,NEWSPOTS
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,IXP,IYP,L,IFAIL,ISTAT,IBUTTON,IFLAG
CHARACTER STR*100,LINE*80
LOGICAL SNEWSPT
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL MXDDLG,CCPDPN,XDLF_POPUP_NOTICE
C ..
C .. Intrinsic Functions ..
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C ..
C .. Common blocks ..
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
IXP = 400
IYP = 400
ISPOT = 10
STR = 'Saving spots, filename ('//SPTNAM(1:LENSTR(SPTNAM))
+ //'): '
C
C---- Don't ask for spots filename if in autoindexing mode
C
10 IF (.NOT.AUTOIND) THEN
CALL MXDDLG(STR, IXP,IYP,NSPTNAM,ISTAT)
I = LENSTR(NSPTNAM)
ELSE
I = 0
END IF
C
IF (I.NE.0) SPTNAM = NSPTNAM
IFAIL = 1
CALL CCPDPN (ISPOT,SPTNAM,'UNKNOWN','F',80,IFAIL)
C
C---- Trap file open failure
C
IF (IFAIL.LT.0) THEN
LINE = 'Cannot open file'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),0,
+ XDLSTR('Try again'),9,XDLSTR('Abort'),5,3,0,IBUTTON)
IF (IBUTTON.EQ.1) THEN
GOTO 10
ELSE
IFLAG = 1
END IF
END IF
IFLAG = 1
IF (AUTOIND) THEN
SNEWSPT = NEWSPT
NEWSPT = .TRUE.
END IF
CALL WSPOT(IFLAG)
IF (AUTOIND) THEN
NEWSPT = SNEWSPT
END IF
NEWSPOTS = .FALSE.
RETURN
END
C== MERGHKL ==
SUBROUTINE MERGHKL(IHKLSTR,NSTRAT,NUNIQ,NTOT,IORDER)
C
C
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- Merge the reflections generated by REEK with the unique reflection list
C
C IHKLSTR Array containing the reflections
C NSTRAT Number of reflections generated by REEK
C NUNIQ Number of unique reflections
C
C Need to use IHKLSTR(1,NTOT) onwards are working array
C .. Scalar Arguments ..
INTEGER NSTRAT,NUNIQ,NTOT
C
C ..
C .. Array Arguments ..
INTEGER*2 IHKLSTR(MCOLSTR,NREFSTR)
INTEGER IORDER(NTOT)
C ..
C .. Local Scalars ..
INTEGER I,IPU,IPS,N,IFLAG,PHEAD,J,JDUMP
LOGICAL ALLDONE
C ..
C .. Local Arrays ..
REAL ADATA(MCOLSTR)
C ..
C .. External Subroutines ..
EXTERNAL LWREFL,CHECKHKL,LWCLOS
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C ..
C .. Equivalences ..
SAVE
C ..
C ..
N = 0
IPS = 1
JDUMP = 0
ALLDONE = .FALSE.
DO 20 I = 1,NUNIQ
C
C---- IPU is pointer to unique reflection
C IPS is pointer to generated reflection
C
IPU = I + NSTRAT
C
C---- Check indices, IFLAG=0 if indices are equal,
C =1 if unique reflection is next in
C sorted list, =2 if generated reflection is next.
C The unique reflection should ALWAYS be the next one
C
10 CALL CHECKHKL(IHKLSTR,IPU,IPS,IFLAG)
N = N + 1
IF ((IFLAG.EQ.2).AND.(IPS.LT.NSTRAT)) THEN
WRITE(IOUT,FMT=6004) (IHKLSTR(J,IPU),J=1,3),
+ (IHKLSTR(J,IPS),J=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6004) (IHKLSTR(J,IPU),J=1,3),
+ (IHKLSTR(J,IPS),J=1,3)
6004 FORMAT(1X,'Missing unique reflection, unique',
+ ' indices',3I4,' gener indices',3I4)
IORDER(N) = IPS
IPS = IPS + 1
IF (IPS.GT.NSTRAT) GOTO 20
GOTO 10
END IF
C
C---- Indices equal or unique reflection next, store pointer
C
IORDER(N) = IPU
IF (DEBUG(55).AND.(JDUMP.LT.NDEBUG(55))) THEN
JDUMP = JDUMP + 1
WRITE(IOUT,FMT=6000) IPU,N,(IHKLSTR(J,IPU),J=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6000) IPU,N,(IHKLSTR(J,IPU),J=1,3)
6000 FORMAT(1X,'Unique refl number',I5,' stored in',I5,
+ ' Indices',3I5)
END IF
C
C---- Now find all generated reflections with same indices
C
IF (ALLDONE) GOTO 20
12 IF (IFLAG.EQ.0) THEN
N = N + 1
IORDER(N) = IPS
IF (DEBUG(55).AND.(JDUMP.LT.NDEBUG(55))) THEN
WRITE(IOUT,FMT=6002) IPS,N,(IHKLSTR(J,IPS),J=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6002) IPS,N,
+ (IHKLSTR(J,IPS),J=1,3)
END IF
6002 FORMAT(1X,'Generated refl number',I5,' stored in',I5,
+ ' Indices',3I5)
IPS = IPS + 1
IF (IPS.GT.NSTRAT) THEN
ALLDONE = .TRUE.
GOTO 20
END IF
CALL CHECKHKL(IHKLSTR,IPU,IPS,IFLAG)
GOTO 12
END IF
20 CONTINUE
C
C---- Reflection order determined, now write MTZ file
C
C
C----- Write out sorted reflections
C
C
DO 80 I = 1,NTOT
IPS = IORDER(I)
IF (IPS.LE.0) THEN
WRITE(6,*)'ERROR IN MERGHKL, IPS',IPS
GOTO 80
END IF
DO 82 J = 1,MCOLSTR
ADATA(J) = REAL(IHKLSTR(J,IPS))
82 CONTINUE
C ********************
CALL LWREFL(MTZOUT,ADATA)
C ********************
80 CONTINUE
C
C---- Close mtz file
C
C **************
PHEAD = 0
CALL LWCLOS(MTZOUT,PHEAD)
C **************
MTZOPEN = .FALSE.
RETURN
END
c
c
C ==========================
SUBROUTINE MHARVEST(IHFLAG)
C ==========================
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/mharvest.f
INTEGER MAXMTZ
PARAMETER (MAXMTZ = 16)
C .. Scalars in common block /CHARVEST/ ..
CHARACTER HVERSION*80,ProjectName*20,DataSetName*20,
+ HBEAMLINE*10,Precipitant*80,
+ PNAME_COLS(MAXMTZ)*20,
+ DNAME_COLS(MAXMTZ)*20
C .. Scalars in common block /IHARVEST/ ..
LOGICAL USECWD,PNAMEgiven,DNAMEgiven,DOHARVEST
REAL PHhar,Hartemp,
+ HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
CHARACTER*3 MKDIRMODE,CHMODMODE
INTEGER KHFLMS
C ..
C .. Common block /CHARVEST/ ..
COMMON /CHARVEST/HVERSION,ProjectName,DataSetName,
+ HBEAMLINE,Precipitant,
+ PNAME_COLS,DNAME_COLS
C .. Common block /IHARVEST/ ..
COMMON /IHARVEST/USECWD,PHhar,Hartemp,KHFLMS,
+ PNAMEgiven,DNAMEgiven,DOHARVEST,
+ HARETA,HARDIV,HARDIH,MKDIRMODE,CHMODMODE
C ..
C&&*&& end_include ../inc/mharvest.f
C
C---- local
C
INTEGER IHFLAG,klen
INTEGER CHMODRET,IFAIL,IMAGE1,IMAGE2,JDO,KHAR,LL,MKDIRPT
LOGICAL ISITVAX,LEXISTS,ALLDONE
CHARACTER RUNFLAGA*9,RUNFLAGB*9,CIFTIME*50,BUFFER*256,
+ FILENAME*256,HOMEDIR*256,HARVESTHOME*256
INTEGER lenstr
EXTERNAL CCPDPN,HCIFTIME
C
C
SAVE
C
C--- initialise
C
IF (IHFLAG.EQ.0) THEN
DOHARVEST = .true.
PNAMEGIVEN = .false.
DNAMEGIVEN = .false.
USECWD = .false.
PROJECTNAME = ' '
DATASETNAME = ' '
HBEAMLINE = ' '
PRECIPITANT = ' '
PHHAR = -999.9
HARTEMP = -9999.9
c
c 4000 Sets user ID on execution.
c 2000 Sets group ID on execution.
c 0400 Permits read by owner.
c 0200 Permits write by owner.
c 0100 Permits execute or search by owner.
c 0040 Permits read by group.
c 0020 Permits write by group.
c 0010 Permits execute or search by group.
c 0004 Permits read by others.
c 0002 Permits write by others.
c 0001 Permits execute or search by others.
c
c#define S_ISUID 0004000 /* set user id on execution */
c#define S_ISGID 0002000 /* set group id on execution */
c /* ->>> /usr/group definitions <<<- */
c#define S_IRWXU 0000700 /* read,write,execute perm: owner */
c#define S_IRUSR 0000400 /* read permission: owner */
c#define S_IWUSR 0000200 /* write permission: owner */
c#define S_IXUSR 0000100 /* execute/search permission: owner */
c#define S_IRWXG 0000070 /* read,write,execute perm: group */
c#define S_IRGRP 0000040 /* read permission: group */
c#define S_IWGRP 0000020 /* write permission: group */
c#define S_IXGRP 0000010 /* execute/search permission: group */
c#define S_IRWXO 0000007 /* read,write,execute perm: other */
c#define S_IROTH 0000004 /* read permission: other */
c#define S_IWOTH 0000002 /* write permission: other */
c#define S_IXOTH 0000001 /* execute/search permission: other */
c
c
c 04000 set user ID on execution
c 020#0 set group ID on execution if # is 7, 5, 3, or 1
c enable mandatory locking if # is 6, 4, 2, or 0
c This bit is ignored except on regular files; it can be set
c or cleared only by using the symbolic mode.
c 01000 sticky bit (see discussion below)
c 0400 read by owner
c 0200 write by owner
c 0100 execute (search in directory) by owner
c 0070 read, write, execute (search) by group
c 0007 read, write, execute (search) by others
c
c S_ISUID 04000 Set user ID on execution.
c S_ISGID 020#0 Set group ID on execution if # is 7, 5, 3, or 1
c Enable mandatory file/record locking if # is 6, 4, 2, or 0
c S_ISVTX 01000 Save text image after execution (a.k.a. Sticky bit).
c S_IRWXU 00700 Read, write, execute by owner.
c S_IRUSR 00400 Read by owner.
c S_IWUSR 00200 Write by owner.
c S_IXUSR 00100 Execute (search if a directory) by owner.
c S_IRWXG 00070 Read, write, execute by group.
c S_IRGRP 00040 Read by group.
c S_IWGRP 00020 Write by group.
c S_IXGRP 00010 Execute by group.
c S_IRWXO 00007 Read, write, execute (search) by others.
c S_IROTH 00004 Read by others.
c S_IWOTH 00002 Write by others
c S_IXOTH 00001 Execute by others.
c
c
c
c CHMODMODE =o"0000700" .or. o"0000070"
c MKDIRMODE =o"0000700" .or. o"0000070"
C Decimal equivalent of 755
c CHMODMODE = 493
CHMODMODE = '755'
C Decimal equivalent of 700
c MKDIRMODE = 448
MKDIRMODE = '700'
c
c
ALLDONE = .false.
KHFLMS = 0
RETURN
END IF
C
C
IF (.NOT.DOHARVEST) RETURN
IF (ALLDONE) RETURN
ISITVAX = .false.
IMAGE1 = 1
IMAGE2 = 1
C
C---- find serial/etc run numbers
C
IF (NLSUM1.GT.0) THEN
READ (LINESUM1(1) (1:6),FMT=6000) IMAGE1
6000 FORMAT (2X,i4)
IF (NLSUM1.GT.1) THEN
READ (LINESUM1(NLSUM1) (1:6),FMT=6000) IMAGE2
ELSE
IMAGE2 = IMAGE1
END IF
ELSE
RETURN
END IF
C
C---- build run part of file name
C
WRITE (RUNFLAGA,FMT=6002) IMAGE1,IMAGE2
6002 FORMAT (i4,'_',i4)
LL = 0
DO 10 JDO = 1,9
IF (RUNFLAGA(JDO:JDO).NE.' ') THEN
LL = LL + 1
RUNFLAGB(LL:LL) = RUNFLAGA(JDO:JDO)
END IF
10 CONTINUE
C
C---- is it a VAX?
C
BUFFER = ' '
CALL GETENV('SYS$LOGIN',BUFFER)
IF (BUFFER(1:1).NE.' ') THEN
DO 20 JDO = 1,lenstr(BUFFER)
IF (BUFFER(JDO:JDO).EQ.'[') THEN
ISITVAX = .true.
GO TO 30
END IF
20 CONTINUE
END IF
30 CONTINUE
C
C---- is there a projectname
C
IF (PROJECTNAME(1:1).EQ.' ') THEN
WRITE (IOUT,FMT=6004)
IF(ONLINE)WRITE (ITOUT,FMT=6004)
6004 FORMAT (
+' Harvest: NO ProjectName given - no deposit file created')
DOHARVEST = .false.
RETURN
END IF
C
C---- is there a datasetname
C
IF (DATASETNAME(1:1).EQ.' ') THEN
WRITE (IOUT,FMT=6006)
IF(ONLINE)WRITE (ITOUT,FMT=6006)
6006 FORMAT (
+' Harvest: NO DataSetName given - no deposit file created')
DOHARVEST = .false.
RETURN
END IF
C
C---- get correct time format
C
CALL HCIFTIME(CIFTIME)
DO 111 Jdo=1,MAXMTZ
PNAME_COLS(Jdo) = PROJECTNAME
DNAME_COLS(Jdo) = DATASETNAME
111 CONTINUE
C
C---- test for $HARVESTHOME environment variable
C
HARVESTHOME = ' '
CALL GETENV('HARVESTHOME',HARVESTHOME)
IF (HARVESTHOME .EQ. ' ')THEN
WRITE(IOUT,FMT=6007)
IF(ONLINE)WRITE(ITOUT,FMT=6007)
6007 FORMAT(/,72('*'),/,'Harvest: no HARVESTHOME environment ',
$ 'variable found - this should be assigned',/,'in your ',
$ 'site''s ccp4.setup file; check with your local CCP4 ',
$ 'administrator.',//,'Checking for HOME environment...',
$ /,72('*'))
C
C---- test for $HOME environment variable
C
HOMEDIR = ' '
IF (ISITVAX) THEN
CALL GETENV('SYS$LOGIN',HOMEDIR)
ELSE
CALL GETENV('HOME',HOMEDIR)
END IF
IF (HOMEDIR.EQ.' ') THEN
WRITE(IOUT,FMT=6008)
IF(ONLINE)WRITE(ITOUT,FMT=6008)
6008 FORMAT (
+ ' Harvest: NO HOME environment variable found - ',
+ 'no deposit file created')
DOHARVEST = .false.
RETURN
END IF
ENDIF
C
C---- test for $USER environment variable
C
BUFFER = ' '
IF (ISITVAX) THEN
CALL GETENV('SYS$USER',BUFFER)
ELSE
CALL GETENV('USER',BUFFER)
END IF
IF (BUFFER.EQ.' ') THEN
WRITE(IOUT,FMT=6010)
IF(ONLINE)WRITE(ITOUT,FMT=6010)
6010 FORMAT (
+' Harvest: NO USER environment variable found - ',
+'no deposit file created')
DOHARVEST = .false.
RETURN
END IF
C
C---- if user RAXIS or pxuser USECWD true
C
IF (BUFFER.EQ.'pxuser') USECWD = .true.
IF (BUFFER.EQ.'raxis') USECWD = .true.
C
C---- build harvest file name
C
IF (USECWD) THEN
IF (.NOT.ISITVAX) THEN
FILENAME = './'//DATASETNAME(1:lenstr(DATASETNAME))//'.'//
+ 'mosflm_run_'//RUNFLAGB(1:lenstr(RUNFLAGB))
ELSE
FILENAME = DATASETNAME(1:lenstr(DATASETNAME))//'.'//
+ 'mosflm_run_'//RUNFLAGB(1:lenstr(RUNFLAGB))
END IF
ELSE
C
C---- see if $HOME/DepositFiles directory exists
C what about VMS ?
C
IF(HARVESTHOME.NE.' ')HOMEDIR=HARVESTHOME
IF (ISITVAX) THEN
FILENAME = HOMEDIR(1:lenstr(HOMEDIR))//':[DepositFiles]'
ELSE
FILENAME = HOMEDIR(1:lenstr(HOMEDIR))//'/DepositFiles'
END IF
C
C
INQUIRE (FILE=FILENAME,EXIST=LEXISTS)
C
C
IF (.NOT.LEXISTS) THEN
klen =lenstr(FILENAME)
print*,'pawsing to make directory'
call cmkdir(FILENAME(1:klen),MKDIRMODE,MKDIRPT)
print*,'directory should have been made'
print*,FILENAME(1:klen),MKDIRPT,klen,MKDIRMODE
IF (MKDIRPT.LT.0) THEN
WRITE(IOUT,FMT=6012)HOMEDIR(1:LENSTR(HOMEDIR))
IF(ONLINE)WRITE(ITOUT,FMT=6012)HOMEDIR(1:LENSTR(HOMEDIR))
6012 FORMAT (
+ ' Harvest: Can''t mkdir ',a,'/DepositFiles - ',
+ 'no deposit file created')
DOHARVEST = .false.
RETURN
ELSE
WRITE(IOUT,FMT=6013)FILENAME(1:LENSTR(FILENAME))
IF(ONLINE)WRITE(ITOUT,FMT=6013)FILENAME(1:LENSTR(FILENAME))
6013 FORMAT(/,
$ 'Harvest: Directory ',a,' created.',/)
END IF
klen = lenstr(FILENAME)
call cchmod(FILENAME(1:klen),CHMODRET,klen,CHMODMODE)
IF (CHMODRET.NE.0) THEN
WRITE(IOUT,FMT=6014)
IF(ONLINE)WRITE(ITOUT,FMT=6014)
6014 FORMAT (
+' Harvest: Can''t chmod HOME/DepositFiles to world read - ',
+'no deposit file created')
DOHARVEST = .false.
RETURN
END IF
END IF
C
C---- now look for ProjectName sub-directory
C
IF (ISITVAX) THEN
FILENAME = FILENAME(1:lenstr(FILENAME)-1)//'.'//
+ PROJECTNAME(1:lenstr(PROJECTNAME))//']'
ELSE
FILENAME = FILENAME(1:lenstr(FILENAME))//'/'//
+ PROJECTNAME(1:lenstr(PROJECTNAME))
END IF
C
C---- may test [a]b.dir as a file for inquire
C
INQUIRE (FILE=FILENAME(1:lenstr(FILENAME)),EXIST=LEXISTS)
C
C
IF (.NOT.LEXISTS) THEN
klen =lenstr(FILENAME)
print*,'pausing to make directory'
call cmkdir(FILENAME(1:klen),MKDIRMODE,MKDIRPT)
print*,'directory should have been made'
print*,FILENAME(1:klen),MKDIRPT,klen,MKDIRMODE
IF (MKDIRPT.LT.0) THEN
WRITE(IOUT,FMT=6016)HOMEDIR(1:LENSTR(HOMEDIR)),
$ PROJECTNAME(1:lenstr(PROJECTNAME))
IF(ONLINE)WRITE(ITOUT,FMT=6016)HOMEDIR(1:LENSTR(HOMEDIR)),
$ PROJECTNAME(1:lenstr(PROJECTNAME))
6016 FORMAT (
+' Harvest: Can''t mkdir ',a,a,' - ',
+'no deposit file created')
DOHARVEST = .false.
RETURN
ELSE
WRITE(IOUT,FMT=6017)FILENAME(1:LENSTR(FILENAME))
IF(ONLINE)WRITE(ITOUT,FMT=6017)FILENAME(1:LENSTR(FILENAME))
6017 FORMAT('Harvest: Directory ',a,' created.',/)
END IF
C
klen = lenstr(FILENAME)
call cchmod(FILENAME(1:klen),CHMODRET,klen,CHMODMODE)
IF (CHMODRET.NE.0) THEN
WRITE(IOUT,FMT=6018) FILENAME(1:lenstr(FILENAME))
IF(ONLINE)WRITE(ITOUT,FMT=6018) FILENAME(1:lenstr(FILENAME))
6018 FORMAT (
+' Harvest: Can''t chmod HOME/DepositFiles/',a,
+' to world read - no deposit file created')
DOHARVEST = .false.
RETURN
END IF
END IF
C
C---- now create FileName for deposit information
C
IF (ISITVAX) THEN
FILENAME = FILENAME(1:lenstr(FILENAME))//
+ DATASETNAME(1:lenstr(DATASETNAME))//'.'//
+ 'mosflm_run_'//RUNFLAGB(1:lenstr(RUNFLAGB))
ELSE
FILENAME = FILENAME(1:lenstr(FILENAME))//'/'//
+ DATASETNAME(1:lenstr(DATASETNAME))//'.'//
+ 'mosflm_run_'//RUNFLAGB(1:lenstr(RUNFLAGB))
END IF
END IF
C
C---- now open file
C
IFAIL = 1
KHAR = 88
CALL CCPDPN(-KHAR,FILENAME,'UNKNOWN','F',80,IFAIL)
C
C
WRITE (KHAR,FMT=6020)
+ PROJECTNAME(1:lenstr(PROJECTNAME)),
+ DATASETNAME(1:lenstr(DATASETNAME)),
+ PROJECTNAME(1:lenstr(PROJECTNAME)),
+ DATASETNAME(1:lenstr(DATASETNAME)),
+ CIFTIME(1:lenstr(CIFTIME)),
+ IMAGE1,IMAGE2,
+ HVERSION(1:lenstr(HVERSION))
6020 FORMAT (
+'data_',a,'[',a,']',/,
+'_entry.id ''',a,'''',/,
+'_diffrn.id ''',a,'''',/,
+'_audit.creation_DayTime ''',a,'''',/,
+'_audit.ebi_image_start ',i6,/,
+'_audit.ebi_image_end ',i6,//,
+'_software.name ''MOSFLM''',/,
+'_software.version ''',a,'''',/,
+'_software.classification ''data reduction''',/,
+'_software.contact_author ''Andrew Leslie''',/,
+'_software.contact_author_email ''andrew@mrc-lmb.cam.ac.uk''',/,
+'_software.description ''reflection data processing''',//)
C
C
WRITE (KHAR,FMT=6022) CELL,NUMSPG,SPGNAM,XTOFD/100.0
6022 FORMAT (
+'_cell.length_a ',f8.3,/,
+'_cell.length_b ',f8.3,/,
+'_cell.length_c ',f8.3,/,
+'_cell.angle_alpha ',f8.2,/,
+'_cell.angle_beta ',f8.2,/,
+'_cell.angle_gamma ',f8.2,//,
+'_Symmetry.Int_Tables_number ',i5,/,
+'_Symmetry.space_group_name_H-M ''',a,'''',//,
+'_diffrn_measurement.detector_distance ',f8.4,/,
+'_diffrn_measurement.device ''oscillation camera''')
C
C _diffrn.ambient_temp
C The mean temperature in kelvins at which the intensities were
C measured.
C
WRITE (KHAR,FMT=6024) WAVE
6024 FORMAT (
+'_diffrn_radiation.wavelength_id 1',/,
+'_diffrn_radiation_wavelength.wavelength ',f8.4,/)
IF (HARTEMP .gt. -9998.0) THEN
C
C--- very crude if HARTEMP .lt. 50 then it is Celsius
C
IF (HARTEMP .le. 50.0) HARTEMP = HARTEMP + 273.0
WRITE (KHAR,FMT=6025) HARTEMP
6025 FORMAT(
+'_diffrn.ambient_temp ',f8.3,/)
END IF
C
C The pH of the solution/buffer/cryo at which the crystal
C was used for data collection
C
IF ( PHHAR .gt. -998.0) WRITE(KHAR,FMT=6125) PHHAR
6125 FORMAT('_diffrn.ebi_pH ',f4.2,/)
C
C---- this is too complex to itemise for users for
C 'voluntary input' - just use .details
C
C
C _EXPTL_CRYSTAL_GROW_COMP
C Data items in the EXPTL_CRYSTAL_GROW_COMP category record
C details about the components of the solutions that were 'mixed'
C (by whatever means) to produce the crystal.
C In general, solution 1 is the solution that contains the
C molecule to be crystallized and solution 2 is the solution
C that contains the precipitant. However, the number of solutions
C required to describe the crystallization protocol is not limited
C to 2.
C Details of the crystallization protocol should be described in
C EXPTL_CRYSTAL_GROW_DETAILS, using the solutions described in
C EXPTL_CRYSTAL_GROW_COMP.
C loop_
C _exptl_crystal_grow_comp.crystal_id
C _exptl_crystal_grow_comp.id
C _exptl_crystal_grow_comp.sol_id
C _exptl_crystal_grow_comp.name
C _exptl_crystal_grow_comp.volume
C _exptl_crystal_grow_comp.conc
C _exptl_crystal_grow_comp.details
C 1 1 1 'HIV-1 protease' '0.002 ml' '6 mg/ml'
C ;
C The protein solution was in a buffer containing 25 mM NaCl, 100 mM NaMES/
C MES buffer, pH 7.5, 3 mM NaAzide
C ;
C 1 2 2 'NaCl' '0.200 ml' '4 M' 'in 3 mM NaAzide'
C 1 3 2 'Acetic Acid' '0.047 ml' '100 mM' 'in 3 mM NaAzide'
C 1 4 2 'Na Acetate' '0.053 ml' '100 mM'
C ; in 3 mM NaAzide. Buffer components were mixed to produce a pH of 4.7
C according to a ratio calculated from the pKa. The actual pH of solution 2
C was not measured.
C ;
C 1 5 2 'water' '0.700 ml' 'neat' 'in 3 mM NaAzide'
C
C_exptl_crystal_grow_comp.conc
C The concentration of the solution component.
C
C _exptl_crystal_grow_comp.details
C A description of any special aspects of the solution component.
C When the solution component is the one that contains the
C macromolecule, this could be the specification of the buffer in
C which the macromolecule was stored. When the solution component
C is a buffer component, this could be the methods (or formula)
C used to achieve a desired pH.
C
C _item_examples.case 'in 3 mM NaAzide'
C The protein solution was in a buffer
C containing 25 mM NaCl, 100 mM NaMES/MES
C buffer, pH 7.5, 3 mM NaAzide
C
C in 3 mM NaAzide. Buffer components were mixed
C to produce a pH of 4.7 according to a ratio
C calculated from the pKa. The actual pH of
C solution 2 was not measured.
C
C_exptl_crystal_grow_comp.id
C The value of _exptl_crystal_grow_comp.id must uniquely identify
C each item in the EXPTL_CRYSTAL_GROW_COMP list.
C Note that this item need not be a number; it can be any unique
C identifier.
C
C_exptl_crystal_grow_comp.name
C A common name for the component of the solution.
C _item_examples.case 'protein in buffer'
C 'acetic acid'
C
C_exptl_crystal_grow_comp.sol_id
C An identifier for the solution to which the given solution
C component belongs.
C
C_exptl_crystal_grow_comp.volume
C The volume of the solution component.
C
IF (PRECIPITANT .ne. ' ')
+ WRITE(KHAR,FMT=6225) PRECIPITANT(1:LENSTR(PRECIPITANT))
6225 FORMAT(
+'_exptl_crystal_grow_comp.details',/,';',/,a,/,';',/)
C
C---- isyn = 1 synchrotron
C = 0 no
C
IF (ISYN.EQ.0) THEN
WRITE (KHAR,FMT=6026)
6026 FORMAT ('_diffrn_source.source ''rotating anode''')
ELSE IF (ISYN.EQ.1) THEN
WRITE (KHAR,FMT=6028)
6028 FORMAT ('_diffrn_source.source ''synchrotron''')
C
C_diffrn_source.type 'Rigaku RU-200'
C 'NSLS beamline X8C'
C
IF (HBEAMLINE.NE.' ') WRITE (KHAR,
+ FMT=6030) HBEAMLINE(1:lenstr(HBEAMLINE))
6030 FORMAT ('_diffrn_source.type ''beamline', a,'''')
END IF
C
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C
IF (ICASS.EQ.0) THEN
WRITE (KHAR,FMT=6032)
6032 FORMAT ('_diffrn_detector.detector ''Flat Film''')
ELSE IF (ICASS.EQ.1) THEN
WRITE (KHAR,FMT=6034)
6034 FORMAT ('_diffrn_detector.detector ''Vee Shaped Cassettes''')
ELSE IF (ICASS.EQ.2) THEN
WRITE (KHAR,FMT=6036)
6036 FORMAT ('_diffrn_detector.detector ''FAST detector''')
ELSE IF (ICASS.EQ.3) THEN
WRITE (KHAR,FMT=6038)
6038 FORMAT ('_diffrn_detector.detector ''Swung out FAST''')
ELSE IF (ICASS.EQ.4) THEN
WRITE (KHAR,FMT=6040)
6040 FORMAT ('_diffrn_detector.detector ''image plate detector''')
END IF
C
C WRITE(IOUT,FMT=7330) MACHINE,MODEL,INVERTX,SPIRAL,ORTHOG,
C + OMEGAFD
C 7330 FORMAT(1X,'Machine type: ',A,' Model type: ',A,' INVERTX',
C + l3,' SPIRAL',L3,' ORTHOG',L3,' OMEGA',F7.1)
C
C MACHINE and MODEL denote the type of detector.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C
IF (SPIRAL) THEN
WRITE (KHAR,FMT=6042) MACHINE(1:lenstr(MACHINE)),
+ MODEL(1:lenstr(MODEL))
6042 FORMAT (
+'_diffrn_detector.type ''',a,'_',a,' with spiral readout''')
ELSE IF (ORTHOG) THEN
WRITE (KHAR,FMT=6044) MACHINE(1:lenstr(MACHINE)),
+ MODEL(1:lenstr(MODEL))
6044 FORMAT (
+'_diffrn_detector.type ''',a,'_',a,' with orthogonal scan''')
END IF
C
C---- TOR For synchrotron sources, degree of polarisation of the beam
C
IF (ISYN.EQ.1) WRITE (KHAR,FMT=6046) TOR
6046 FORMAT ('_diffrn_radiation.polarisn_ratio ',f8.4)
C
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C If the data has been collected at a synchrotron source,
C the polarisation of the beam and the horizontal and
C vertical divergences (horizontal here means in the plane
C of the X-ray beam and the rotation axis) should be given. Values
C default to those for the SRS at Daresbury, UK.
C
IF (IMONO.EQ.0) THEN
WRITE (KHAR,FMT=6048)
6048 FORMAT (
+'_diffrn_radiation.polarisation_collimation ',
+'''pinhole or mirrors with unpolarised beam''')
ELSE IF (IMONO.EQ.1) THEN
WRITE (KHAR,FMT=6050)
6050 FORMAT (
+'_diffrn_radiation.polarisation_collimation ',
+'''graphite monochromator''')
ELSE IF (IMONO.EQ.2) THEN
WRITE (KHAR,FMT=6052)
6052 FORMAT (
+'_diffrn_radiation.polarisation_collimation ',
+'''synchrotron''')
END IF
C
C--- khflms HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
C
HDIV=0.0
HETA=0.0
HDIH=0.0
HETAMX = -9999.0
HETAMI = 9999.0
DO 50 JDO=1,KHFLMS
HDIV = HDIV + HARDIV(JDO)
HDIH = HDIH + HARDIH(JDO)
HETA = HETA + HARETA(JDO)
IF (HARETA(JDO) .GT. HETAMX) HETAMX = HARETA(JDO)
IF (HARETA(JDO) .LT. HETAMI) HETAMI = HARETA(JDO)
50 CONTINUE
C
C
WRITE (KHAR,FMT=6054) HETAMI,HETAMX,
+ HETA/KHFLMS,HDIH/KHFLMS,HDIV/KHFLMS
6054 FORMAT (/,
+'_ebi_diffrn_images.mosaicity_min ',f8.3,/,
+'_ebi_diffrn_images.mosaicity_max ',f8.3,/,
+'_ebi_diffrn_images.mosaicity_mean ',f8.3,/,
+'_ebi_diffrn_images.beam_divergence_Horizontal_mean ',f8.3,/,
+'_ebi_diffrn_images.beam_divergence_Vertical_mean ',f8.3,/)
C
C RESID
C
C The rms positional residual (in mm) after refinement of the detector
C parameters. For strong images this should be between 0.02 and 0.04. For weak
C images or large spots (due to high mosaic spread) it can be significantly
C higher. If partials have to be included in the refinement it will also be
C higher. A dataset with rms residuals of 0.2 to 0.3 can still give a final
C Rmerge of under 10% ! Remember a residual of 0.15 is still only one pixel.
C If the residual is greater then 0.04 for a strong image, there is almost
C certainly an error in the cell parameters, and they should be refined using
C the POSTREFINEMENT options. Even for weaker images, the positional residual
C for the initial refinement (using only central spots) should be small.
C
C WRESID
C The weighted residual. This should be close to unity (independent of the
C strength of the image). Larger values suggest errors in cell parameters or
C crystal orientation.
C
C
C I/SIGI
C
C This gives the average I/sd(I) for the whole dataset
C (first column) and the outermost resolution bin (second column).
C Probably the most useful is the breakdown of I/sig(I) as a
C function of resolution. This will give an immediate idea of the
C quality of the data...particularly at the high resolution end. For
C guidance, a mean I/sig(I) of 3.0 will give an
C R-merge of between 20% and 30% in AGROVATA.
C If there are symmetry related fully recorded (or summed partial)
C reflections on a single image, statistics are also provided on
C the agreement between their intensities.
C
C
C Rsym
C
C This gives the R-factor (on intensities) for symmetry related
C fully recorded (or summed partial) reflections on the same image.
C
C
C Nsym
C
C The number of reflections (not the number of observations)
C included in Rsym.
C
C
C SDRAT
C
C The ratio of the observed agreement between symmetry related
C reflection intensities to their estimated standard deviations.
C This should have a value of 1.4 if there are two measurements
C of each reflection, or very close to unity if four or more.
C This can be more useful than the Rsym value, as it should not
C depend on the intensity of the measurements while Rsym will always
C be higher for weak spots.
C
C---- IP format
C
C PACK CCX CCY CCOM DIST YSCALE TILT TWIST ROFF TOFF RESID WRESID
C FULL PART OVRL NEG BAD I/SIGI I/SIGI Rsym Nsym SDRAT
C 6067 FORMAT (2X,I4,3F6.2,F6.1,F6.3,I5,I6,2F6.2,F6.3,F7.1,
C + I7,I6,2I5,I4,2F7.1,F8.3,I5,F6.1)
c123456789012345678901234567890123456789012345678901234567890123456789012
C123456xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxiiiiiIIIIIIffffff6666661234567777777
C IMGP is true if working with image plate data
C
WRITE (KHAR,6055) WAVE/DSTMAX,WAVE/DSTMIN
6055 FORMAT(
+'_diffrn_measurement.ebi_d_res_high ',f8.3,/,
+'_diffrn_measurement.ebi_d_res_low ',f8.3,/)
C
C
IF (IMGP) THEN
WRITE (KHAR,FMT=6056)
6056 FORMAT (/,
+'loop_',/,
+'_ebi_diffrn_images.id ',/,
+'_ebi_diffrn_images.rms_positional_residual',/,
+'_ebi_diffrn_images.weighted_rms_positional_residual',/,
+'_ebi_diffrn_images.mean_I_over_SigmaI',/,
+'_ebi_diffrn_images.I_over_Sigma_I_res_high',/,
+'_ebi_diffrn_images.Intensity_R_factor_symmetry_reflection',/,
+'_ebi_diffrn_images.number_symmetry_related_observations',/,
+'_ebi_diffrn_images.agreement_ratio_symm_Int_to_esd')
c
c
cstarting definitions from mosflm.doc file:
c------------------------------------------
csave__ebi_diffrn_images.id
c
csave__ebi_diffrn_images.rms_positional_residual
c
c The rms positional residual (in mm) after refinement of the detector
c parameters. For strong images this should be between 0.02 and 0.04. For weak
c images or large spots (due to high mosaic spread) it can be significantly
c higher. If partials have to be included in the refinement it will also be
c higher. A dataset with rms residuals of 0.2 to 0.3 can still give a final
c Rmerge of under 10% ! Remember a residual of 0.15 is still only one pixel.
c If the residual is greater then 0.04 for a strong image, there is almost
c certainly an error in the cell parameters, and they should be refined using
c the POSTREFINEMENT options. Even for weaker images, the positional residual
c for the initial refinement (using only central spots) should be small.
c
csave__ebi_diffrn_images.weighted_rms_psoitional_residual
c
c The weighted residual. This should be close to unity (independent of the
c strength of the image). Larger values suggest errors in cell parameters or
c crystal orientation.
c
c
csave__ebi_diffrn_images.mean_I_over_SigmaI
csave__ebi_diffrn_images.I_over_Sigma_I_res_high
c
c This gives the average I/sd(I) for the whole dataset
c and the outermost resolution bin (for resolution set in
c _diffrn_measurement.ebi_d_res_high
c _diffrn_measurement.ebi_d_res_low )
c Probably the most useful is the breakdown of I/sig(I) as a
c function of resolution. This will give an immediate idea of the
c quality of the data...particularly at the high resolution end. For
c guidance, a mean I/sig(I) of 3.0 will give an
c R-merge of between 20% and 30% in AGROVATA.
c If there are symmetry related fully recorded (or summed partial)
c reflections on a single image, statistics are also provided on
c the agreement between their intensities.
c
c
csave__ebi_diffrn_images.Intensity_R_factor_symmetry_reflection
c
c This gives the R-factor (on intensities) for symmetry related
c fully recorded (or summed partial) reflections on the same image.
c
c
csave__ebi_diffrn_images.number_symmetry_related_observations
c
c The number of reflections (not the number of observations)
c included in Rsym.
c
c
csave__ebi_diffrn_images.agreement_ratio_symm_Int_to_esd
c
c The ratio of the observed agreement between symmetry related
c reflection intensities to their estimated standard deviations.
c This should have a value of 1.4 if there are two measurements
c of each reflection, or very close to unity if four or more.
c This can be more useful than the Rsym value, as it should not
c depend on the intensity of the measurements while Rsym will always
c be higher for weak spots.
c
c
c
C
C_diffrn_reflns.av_R_equivalents
C_diffrn_reflns.av_sigmaI_over_netI
C
DO 40 JDO = 1,NLSUM1
WRITE (KHAR,FMT=6058)
+ LINESUM1(JDO) (1:6),
+ LINESUM1(JDO) (60:65),
+ LINESUM1(JDO) (66:72),
+ LINESUM1(JDO) (100:106),
+ LINESUM1(JDO) (107:113),
+ LINESUM1(JDO) (114:121),
+ LINESUM1(JDO) (122:126),
+ LINESUM1(JDO) (127:132)
6058 FORMAT (a6,2X,a6,2X,3 (2X,a7),2X,a8,2X,a5,2X,a6)
40 CONTINUE
END IF
C
CLOSE (UNIT=KHAR)
C
C
RETURN
END
c
c ============================
subroutine hciftime(ciftime)
c ============================
ccFrom GERARD@XRAY.BMC.UU.SE Thu Sep 24 00:25:25 1998
c
implicit none
c
character ciftime*(*)
c
integer gmt_hour,gmt_minutes,localdaymonth,
+ localhours,localminutes,localmonth,localseconds,
+ localyear,nhours,nminutes,stime,diff
c
character gmt_diff*1
c
integer gmtarray(9),tarray(9)
integer time
c
intrinsic abs
c
code ...
c
c ... check if the argument can hold 25 characters
c (better to return an error flag, of course ;-)
c
if (len(ciftime) .lt. 25) then
print *,'error --- hciftime: string too short'
ciftime = char(0)
return
end if
c
stime = time()
call gmtime(stime,gmtarray)
call ltime(stime,tarray)
c
nminutes = gmtarray(2)
nhours = gmtarray(3)
localseconds = tarray(1)
localminutes = tarray(2)
localhours = tarray(3)
localdaymonth = tarray(4)
localmonth = tarray(5) + 1
localyear = tarray(6) + 1900
c
c ... calculate time difference in minutes (some time zones
c differ by N hours + 30 minutes from gmt)
c
diff = (60*localhours + localminutes) -
+ (60*nhours + nminutes)
c
c ... allow for different dates to avoid Kim's midnight bug
c (fudge by simply checking if the day of the month is
c identical or not; should be okay)
c
if (diff .lt. 0 .and. tarray(4) .ne. gmtarray(4)) then
diff = diff + 24*60
else if (diff .gt. 0 .and. tarray(4) .ne. gmtarray(4)) then
diff = diff - 24*60
end if
c
c ... get hour differences by taking INT(minutes)/60
c since INT(-1.5) would be -2, use ABS and adjust sign
c
gmt_hour = abs(diff) / 60
if (diff .lt. 0) gmt_hour = - gmt_hour
gmt_minutes = diff - 60*gmt_hour
if (gmt_hour .lt. 0 .or. gmt_minutes .lt. 0) then
gmt_diff = '-'
else
gmt_diff = '+'
end if
c
write (ciftime,fmt=6000) localyear,localmonth,localdaymonth,
+ localhours,localminutes,localseconds,gmt_diff,abs(gmt_hour),
+ abs(gmt_minutes)
c
c ... NOTE: "i4" in the following format makes that this routine
c is not Year-10,000-compliant !!!
c
6000 format (i4,'-',i2.2,'-',i2.2,'T',i2.2,':',i2.2,':',i2.2,a1,i2.2,
+ ':',i2.2)
c
return
end
C== MINV ==
C
C
C
SUBROUTINE MINV(A,N,D,L,M)
C ==========================
C
C
C
C
C
C .. Scalar Arguments ..
REAL D
INTEGER N
C ..
C .. Array Arguments ..
REAL A(*)
INTEGER L(*),M(*)
C ..
C .. Local Scalars ..
REAL BIGA,HOLD
INTEGER I,IJ,IK,IZ,J,JI,JK,JP,JQ,JR,K,KI,KJ,KK,NK
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C
C
D = 1.0
NK = -N
C
C
DO 90 K = 1,N
NK = NK + N
L(K) = K
M(K) = K
KK = NK + K
BIGA = A(KK)
C
C
DO 20 J = K,N
IZ = (J-1)*N
C
C
DO 10 I = K,N
IJ = IZ + I
C
C
IF ((ABS(BIGA)-ABS(A(IJ))).LT.0) THEN
BIGA = A(IJ)
L(K) = I
M(K) = J
END IF
C
C
10 CONTINUE
20 CONTINUE
C
C---- Interchange rows
C
J = L(K)
C
C
IF ((J-K).GT.0) THEN
KI = K - N
C
C
DO 30 I = 1,N
KI = KI + N
HOLD = -A(KI)
JI = KI - K + J
A(KI) = A(JI)
A(JI) = HOLD
30 CONTINUE
C
C
END IF
C
C---- Interchange columns
C
I = M(K)
C
C
IF ((I-K).GT.0) THEN
JP = (I-1)*N
C
C
DO 40 J = 1,N
JK = NK + J
JI = JP + J
HOLD = -A(JK)
A(JK) = A(JI)
A(JI) = HOLD
40 CONTINUE
END IF
C
C---- Divide column by minus pivot
C
IF (BIGA.EQ.0) THEN
GO TO 130
ELSE
C
C
DO 50 I = 1,N
IF ((I-K).NE.0) THEN
IK = NK + I
A(IK) = A(IK)/ (-BIGA)
END IF
50 CONTINUE
C
C---- Reduce matrix
C
DO 70 I = 1,N
IK = NK + I
HOLD = A(IK)
IJ = I - N
C
C
DO 60 J = 1,N
IJ = IJ + N
C
C
IF ((I-K).NE.0) THEN
IF ((J-K).NE.0) THEN
KJ = IJ - I + K
A(IJ) = A(KJ)*HOLD + A(IJ)
END IF
END IF
C
C
60 CONTINUE
70 CONTINUE
C
C---- Divide row by pivot
C
KJ = K - N
C
C
DO 80 J = 1,N
KJ = KJ + N
IF ((J-K).NE.0) A(KJ) = A(KJ)/BIGA
80 CONTINUE
C
C---- Product of pivots
C
C D=D*BIGA
C
C---- Replace pivot by reciprocal
C
A(KK) = 1.0/BIGA
END IF
90 CONTINUE
C
C---- Final row and column interchange
C
K = N
100 CONTINUE
K = (K-1)
C
C
IF (K.GT.0) THEN
I = L(K)
C
C
IF ((I-K).GT.0) THEN
JQ = (K-1)*N
JR = (I-1)*N
C
C
DO 110 J = 1,N
JK = JQ + J
HOLD = A(JK)
JI = JR + J
A(JK) = -A(JI)
A(JI) = HOLD
110 CONTINUE
C
C
END IF
C
C
J = M(K)
C
C
IF ((J-K).GT.0) THEN
KI = K - N
C
C
DO 120 I = 1,N
KI = KI + N
HOLD = A(KI)
JI = KI - K + J
A(KI) = -A(JI)
A(JI) = HOLD
120 CONTINUE
C
C
END IF
GO TO 100
END IF
C
C
RETURN
130 D = 0.0
C
C
END
C== MINV33 ==
C
C
C
SUBROUTINE MINV33(A,B,D)
C ======================
C
C---- Invert a general 3x3 matrix and return determinant in d
C
C A=(B)-1
C
C
C
C .. Scalar Arguments ..
REAL D
C ..
C .. Array Arguments ..
REAL A(3,3),B(3,3)
C ..
C .. Local Scalars ..
INTEGER I,J
C ..
C .. Local Arrays ..
REAL C(3,3)
C ..
C .. External Functions ..
REAL DOT
EXTERNAL DOT
C ..
C .. External Subroutines ..
EXTERNAL CROSS
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C
C
C ***************************
CALL CROSS(C(1,1),B(1,2),B(1,3))
CALL CROSS(C(1,2),B(1,3),B(1,1))
CALL CROSS(C(1,3),B(1,1),B(1,2))
C ***************************
C
D = DOT(B(1,1),C(1,1))
C
C---- Test determinant
C
IF (ABS(D).GT.1.0E-30) THEN
C
C---- Determinant is non-zero
C
DO 20 I = 1,3
DO 10 J = 1,3
A(I,J) = C(J,I)/D
10 CONTINUE
20 CONTINUE
C
C
ELSE
D = 0.0
END IF
C
C
END
C== MINV4 ==
SUBROUTINE MINV4(A,AI,IERR)
C ===========================
C
C
C
C Subroutine to invert 4*4 matrices for conversion between
C fractional and orthogonal axes
C
C
C PARAMETERS
C
C A (I) 4*4 MATRIX TO BE INVERTED
C AI (O) INVERSE MATRIX
C
C
C ..
C .. Scalar Arguments ..
INTEGER IERR
C ..
C .. Array Arguments ..
REAL A(4,4),AI(4,4)
C ..
C .. Local Scalars ..
INTEGER II,JJ,I,J,I1,J1
REAL D,AM
C ..
C .. Local Arrays ..
REAL C(4,4),X(3,3)
IERR = 0
C
C---- Get cofactors of 'a' in array 'c'
C
DO 40 II=1,4
DO 30 JJ=1,4
I=0
DO 20 I1=1,4
IF(I1.EQ.II)GO TO 20
I=I+1
J=0
DO 10 J1=1,4
IF(J1.EQ.JJ)GO TO 10
J=J+1
X(I,J)=A(I1,J1)
10 CONTINUE
20 CONTINUE
AM=X(1,1)*X(2,2)*X(3,3)-X(1,1)*X(2,3)*X(3,2)+X(1,2)*X(2,3)*X(3,1)
* -X(1,2)*X(2,1)*X(3,3)+X(1,3)*X(2,1)*X(3,2)-X(1,3)*X(2,2)*X(3,1)
C(II,JJ)=(-1)**(II+JJ)*AM
30 CONTINUE
40 CONTINUE
C
C---- Calculate determinant
C
D=0
DO 50 I=1,4
D=D+A(I,1)*C(I,1)
50 CONTINUE
C
C---- Test for zero determinant
C
IF (ABS(D).LT.0.0000001) THEN
IERR = 1
RETURN
END IF
C
C---- Get inverse matrix
C
DO 70 I=1,4
DO 60 J=1,4
AI(I,J)=C(J,I)/D
60 CONTINUE
70 CONTINUE
RETURN
END
C== MINV ==
C
C
C
SUBROUTINE MINVD(A,N,D,L,M)
C ==========================
C
C
C
C
C
C .. Scalar Arguments ..
DOUBLE PRECISION D
INTEGER N
C ..
C .. Array Arguments ..
DOUBLE PRECISION A(*)
INTEGER L(*),M(*)
C ..
C .. Local Scalars ..
DOUBLE PRECISION BIGA,HOLD
INTEGER I,IJ,IK,IZ,J,JI,JK,JP,JQ,JR,K,KI,KJ,KK,NK
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C
C
D = 1.0
NK = -N
C
C
DO 90 K = 1,N
NK = NK + N
L(K) = K
M(K) = K
KK = NK + K
BIGA = A(KK)
C
C
DO 20 J = K,N
IZ = (J-1)*N
C
C
DO 10 I = K,N
IJ = IZ + I
C
C
IF ((ABS(BIGA)-ABS(A(IJ))).LT.0) THEN
BIGA = A(IJ)
L(K) = I
M(K) = J
END IF
C
C
10 CONTINUE
20 CONTINUE
C
C---- Interchange rows
C
J = L(K)
C
C
IF ((J-K).GT.0) THEN
KI = K - N
C
C
DO 30 I = 1,N
KI = KI + N
HOLD = -A(KI)
JI = KI - K + J
A(KI) = A(JI)
A(JI) = HOLD
30 CONTINUE
C
C
END IF
C
C---- Interchange columns
C
I = M(K)
C
C
IF ((I-K).GT.0) THEN
JP = (I-1)*N
C
C
DO 40 J = 1,N
JK = NK + J
JI = JP + J
HOLD = -A(JK)
A(JK) = A(JI)
A(JI) = HOLD
40 CONTINUE
END IF
C
C---- Divide column by minus pivot
C
IF (BIGA.EQ.0) THEN
GO TO 130
ELSE
C
C
DO 50 I = 1,N
IF ((I-K).NE.0) THEN
IK = NK + I
A(IK) = A(IK)/ (-BIGA)
END IF
50 CONTINUE
C
C---- Reduce matrix
C
DO 70 I = 1,N
IK = NK + I
HOLD = A(IK)
IJ = I - N
C
C
DO 60 J = 1,N
IJ = IJ + N
C
C
IF ((I-K).NE.0) THEN
IF ((J-K).NE.0) THEN
KJ = IJ - I + K
A(IJ) = A(KJ)*HOLD + A(IJ)
END IF
END IF
C
C
60 CONTINUE
70 CONTINUE
C
C---- Divide row by pivot
C
KJ = K - N
C
C
DO 80 J = 1,N
KJ = KJ + N
IF ((J-K).NE.0) A(KJ) = A(KJ)/BIGA
80 CONTINUE
C
C---- Product of pivots
C
C D=D*BIGA
C
C---- Replace pivot by reciprocal
C
A(KK) = 1.0/BIGA
END IF
90 CONTINUE
C
C---- Final row and column interchange
C
K = N
100 CONTINUE
K = (K-1)
C
C
IF (K.GT.0) THEN
I = L(K)
C
C
IF ((I-K).GT.0) THEN
JQ = (K-1)*N
JR = (I-1)*N
C
C
DO 110 J = 1,N
JK = JQ + J
HOLD = A(JK)
JI = JR + J
A(JK) = -A(JI)
A(JI) = HOLD
110 CONTINUE
C
C
END IF
C
C
J = M(K)
C
C
IF ((J-K).GT.0) THEN
KI = K - N
C
C
DO 120 I = 1,N
KI = KI + N
HOLD = A(KI)
JI = KI - K + J
A(KI) = -A(JI)
A(JI) = HOLD
120 CONTINUE
C
C
END IF
GO TO 100
END IF
C
C
RETURN
130 D = 0.0
C
C
END
C== MISMAT ==
SUBROUTINE MISMAT(DELPHI,R)
C ===========================
C
C---- This is identical to ROTMAT except the angles here are in radians rather
C than degrees
C
C---- Forms rotation matrix R from the three angles in DELPHI
C (angles in radians), corresponding to
C
C [R] = [phiz] . [phiy] . [phix]
C
C
C | cz -sz 0 | | cy 0 sy | | 1 0 0 |
C [R] = | sz cz 0 | . | 0 1 0 | . | 0 cx -sx |
C | 0 0 1 | |-sy 0 cy | | 0 sx cx |
C
C ..
C .. Array Arguments ..
REAL DELPHI(3),R(3,3)
C ..
C .. Local Scalars ..
INTEGER I
C ..
C .. Local Arrays ..
REAL C(3),S(3)
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,SIN
C ..
C
C
DO 10 I = 1,3
C(I) = COS(DELPHI(I))
S(I) = SIN(DELPHI(I))
10 CONTINUE
C
C
R(1,1) = C(2)*C(3)
R(1,2) = -C(1)*S(3) + S(1)*S(2)*C(3)
R(1,3) = C(1)*S(2)*C(3) + S(1)*S(3)
R(2,1) = C(2)*S(3)
R(2,2) = S(1)*S(2)*S(3) + C(1)*C(3)
R(2,3) = -S(1)*C(3) + C(1)*S(2)*S(3)
R(3,1) = -S(2)
R(3,2) = S(1)*C(2)
R(3,3) = C(1)*C(2)
C
C
END
C== MKEYER ==
C
C
C
SUBROUTINE MKEYER(I,MODE,LINE,IBEG,IEND,ITYP)
C ============================================
C
C---- Print warning when token not of correct type.
C
C
C
C
C .. Scalar Arguments ..
INTEGER I,MODE
CHARACTER LINE*400
C ..
C .. Array Arguments ..
INTEGER IBEG(200),IEND(200),ITYP(200)
C ..
C .. Local Arrays ..
CHARACTER TYPE(3)*12
C ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C .. Data statements ..
DATA TYPE/'alphanumeric','numeric ','quoted '/
C ..
C
C
IF (MODE.EQ.0) THEN
WRITE (IOUT,FMT=6000) LINE(IBEG(I) :IEND(I))
IF (ONLINE) WRITE (ITOUT,FMT=6000) LINE(IBEG(I) :IEND(I))
ELSE
C
C
WRITE (IOUT,FMT=6002) LINE(IBEG(I) :IEND(I)),TYPE(ITYP(I)),
+ TYPE(MODE)
IF (ONLINE) WRITE (ITOUT,FMT=6002) LINE(IBEG(I) :IEND(I)),
+ TYPE(ITYP(I)),TYPE(MODE)
IOERR = .TRUE.
C
END IF
C
C---- Format statements
C
6000 FORMAT (' ** ERROR : key word <',A,'> not recognized and has, th',
+ 'erefore been ignored')
6002 FORMAT (' ** ERROR: Token <',A,'> is ',A,' while a ',A,' token w',
+ 'as expected')
C
C
END
C== MKEYNM ==
C
C
C
SUBROUTINE MKEYNM(N,NSTART,LINE,IBEG,IEND,ITYP,NTOK)
C ===========================================================
C
C
C---- Check that correct number of numbers are present
C
C
C
C
C
C
C .. Scalar Arguments ..
INTEGER N,NSTART,NTOK
CHARACTER*(*) LINE
C ..
C .. Array Arguments ..
INTEGER IBEG(200),IEND(200),ITYP(200)
C ..
C .. Local Scalars ..
INTEGER I
C ..
C .. External Subroutines ..
EXTERNAL MKEYER
C ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
IOERR = .FALSE.
C
DO 10 I = NSTART,NSTART + N - 1
C
C
IF (I.GT.NTOK) THEN
GO TO 30
ELSE IF (ITYP(I).NE.2) THEN
GO TO 20
END IF
C
C
10 CONTINUE
C
C
RETURN
C
C *******************************
20 CALL MKEYER(I,2,LINE,IBEG,IEND,ITYP)
C *******************************
C
IF (.NOT.ONLINE) STOP
RETURN
30 WRITE (IOUT,FMT=6000) I - NSTART,N
IF (ONLINE) WRITE (ITOUT,FMT=6000) I - NSTART,N
IF (.NOT.ONLINE) STOP
IOERR = .TRUE.
C
C---- Format statements
C
6000 FORMAT (' *** Too few numbers - ',I3,' Found when ',I3,
+ ' Expected')
C
C
END
C 26-Nov-1988 J. W. Pflugrath Cold Spring Harbor Laboratory
C Edited to conform to Fortran 77. Renamed from Multiply_3_matrices to
C ML3MAT
C
C ============================================================================================================== Multiply_3_matrices
C
C! to multiply three matrices
C
SUBROUTINE ML3MAT
C input: 1st side of 1st matrix
1 (P
C input: first matrix
2 ,A
C input: 2nd side of 1st matrix & 1st side of 2nd matrix
3 ,Q
C input: second matrix
4 ,B
C input: 2nd side of 2nd matrix & 1st side of 3rd matrix
5 ,R
C input: third matrix
6 ,C
C input: 2nd side of 3rd matrix
7 ,S
C output: product matrix
8 ,D)
IMPLICIT NONE
C
CEE Multiplies three real matrices of any dimensions. It is not optimised
C for very large matrices.
C Multiply_3_matrices
C*** this routine is inefficient!
C Multiply_3_matrices
Created: 15-NOV-1985 D.J.Thomas, MRC Laboratory of Molecular Biology,
C Hills Road, Cambridge, CB2 2QH, England
C
C ! loop counters
INTEGER I,J,K,L
C ! loop limits
INTEGER P,Q,R,S
C ! first input matrix
REAL A (1:P,1:Q)
C ! second input matrix
REAL B (1:Q,1:R)
C ! third input matrix
REAL C (1:R,1:S)
C ! output matrix
REAL D (1:P,1:S)
C
DO 100 L = 1, S
DO 100 I = 1, P
D(I,L) = 0.0
DO 100 K = 1, R
DO 100 J = 1, Q
C
C ! accumulate product matrix D=ABC
C
100 D(I,L) = D(I,L) + A(I,J) * B(J,K) * C(K,L)
CONTINUE
CONTINUE
CONTINUE
CONTINUE
C Multiply_3_matrices
RETURN
END
C ==============================================================
SUBROUTINE MMSYMLB(IST,LSPGRP,NAMSPG,NAMPG,NSYMP,NSYM,ROT,IERR)
C ==============================================================
C
C---- Takken from CCP4 library, modified to trap error if spacegroup
C symmetry not found
C
C---- Get symmetry operations for spacegroup LSPGRP from library file
C on stream IST, logical name SYMOP.
C
C In the library file, the header for each entry is
C
C LSPGRP NLINS NLINP NAMSPG NAMPG
C
C where LSPGRP spacegroup number
C NLINS total number of lines of symmetry operators.
C NLINP number of LINES of primitive symmetry operators
C NAMSPG spacegroup name
C NAMPG name of corresponding pointgroup
C
C
C
C On entry:
C IST stream number to read file
C LSPGRP spacegroup number
C NAMSPG spacegroup name: this will be used to find the
C spacegroup only if LSPGRP = 0
C
C Returns
C LSPGRP spacegroup number
C NAMSPG spacegroup name
C NAMPG pointgroup name
C NSYMP number of primitive symmetry operations - only different
C from NSYM in non-primitive spacegroups
C NSYM total number of symmetry operations
C ROT(4,4,NSYM) rotation/translation matrices
C
C IERR non-zero if spacegroup entry not found in SYMLIB
C
C .. Parameters ..
INTEGER NPARSE
PARAMETER (NPARSE=200)
C ..
C .. Scalar Arguments ..
INTEGER IST,LSPGRP,NSYM,NSYMP
CHARACTER NAMPG* (*),NAMSPG* (*)
C ..
C .. Array Arguments ..
REAL ROT(4,4,*)
C ..
C .. Local Scalars ..
INTEGER I,IFAIL,ISG,NLIN,NLINS,NTOK
CHARACTER LINE*400,LINERR*400
C ..
C .. Local Arrays ..
REAL FVALUE(NPARSE)
INTEGER IBEG(NPARSE),IDEC(NPARSE),IEND(NPARSE),ITYP(NPARSE)
CHARACTER CVALUE(NPARSE)*4
C ..
C .. External Subroutines ..
EXTERNAL CCPDPN,CCPUPC,PARSE,SYMFR2,LERROR,LENSTR
INTEGER LENSTR
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
IFAIL = 0
IERR = 0
C Open symmetry file. Print file-opening noise only if the
C `debugging level' has been set greater than the default (1).
CAL Remove this(QPRVL not yet in all libraries)
CAL CALL QPRLVL(I)
I = 0
IF (I.GT.1) THEN
CALL CCPOPN(IST,'SYMOP',5,1,0,IFAIL)
ELSE
CALL CCPOPN(-IST,'SYMOP',5,1,0,IFAIL)
END IF
C
NTOK = 0
NSYM = 0
C
10 CONTINUE
C
C---- Find correct space-group in file.
C Each space-group has header line of space-group number,
C number of line of symmetry operations for non-primitive
C and primitive cells.
C
READ (IST,FMT='(A)',ERR=30,END=30) LINE
CALL CCPUPC(LINE)
NTOK = -NPARSE
CALL PARSE(LINE,IBEG,IEND,ITYP,FVALUE,CVALUE,IDEC,NTOK)
C
C---- Fields are space group number,
C number of lines,
C number of lines in primitive cell symmetry,
C spacegroup name
C
IF (ITYP(1).NE.2 .OR. ITYP(2).NE.2 .OR. ITYP(3).NE.2)
+ CALL LERROR(2,-1,'MSYMLB: Error in format of SYMOP file: '
+ // LINE)
ISG = NINT(FVALUE(1))
NLIN = NINT(FVALUE(2))
NLINS = NINT(FVALUE(3))
IF (LSPGRP.GT.0) THEN
C
C---- Check for spacegroup number given
C
IF (LSPGRP.EQ.ISG) GO TO 40
C
C---- Check for spacegroup name given
C
ELSE IF (NAMSPG.EQ.LINE(IBEG(4) :IEND(4))) THEN
GO TO 40
END IF
C
C---- Not this one, skip NLIN lines
C
DO 20 I = 1,NLIN
READ (IST,FMT=*)
20 CONTINUE
C try again
GO TO 10
C
40 CONTINUE
C
C---- Space-group found, convert NLIN lines of
C symmetry operators to matrices
C
LSPGRP = ISG
NAMSPG = LINE(IBEG(4) :IEND(4))
NAMPG = LINE(IBEG(5) :IEND(5))
C
DO 50 I = 1,NLINS
READ (IST,FMT='(A)') LINE
C Convert line to matrices
NSYM = NSYM + 1
CALL SYMFR2(LINE,1,NSYM,ROT)
50 CONTINUE
C
NSYMP = NSYM
IF (NLIN.GT.NLINS) THEN
DO 60 I = NLINS + 1,NLIN
READ (IST,FMT='(A)') LINE
C Convert line to matrices
NSYM = NSYM + 1
CALL SYMFR2(LINE,1,NSYM,ROT)
60 CONTINUE
END IF
C
CLOSE (IST)
RETURN
C
30 CONTINUE
WRITE (LINERR,FMT='(A,A,I5,A)')
+ 'MSYGET: No symmetry information for space group ',
+ ' number',LSPGRP,' in SYMOP file'
IERR = 1
CLOSE (IST)
END
C== MMTOPX ==
SUBROUTINE MMTOPX(XC,YC,X,Y)
C ============================
C
IMPLICIT NONE
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C---- Converts generate file coordinates X,Y in 10micron units
C (relative to direct beam position)
C to XC,YC 10micron units in the scanner coordinate frame,
C with respect to the lower left corner of the image (that is,
C the first pixel in the digitised image as it is stored internally
C in MOSFLM IMAGE array) (and not the middle !).
C
C For the image plate, TOFF is a tangential offset, ROFF is
C a radial offset, RDTOFF is the radial dependence of TOFF.
C .. Scalar Arguments ..
REAL X,XC,Y,YC
C ..
C .. Local Scalars ..
REAL A0,ABSX,B0,BY,CB,DISTOR,DOV2,DXTOF,FB,FR,R,SB,XD,XDASH,XM,
+ XMP,XX,YM,YMP,YY,PSI,CPSI,SPSI,XMID,YMID,RAD,RSCAN,PI,
+ CURVE1,CURVE2,XRED,YRED
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,EXP,SIGN,SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/tiltlog.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- awk generated include file tiltlog.h
C---- START of include file tiltlog.h
C
C for things connected with the new definitions of TILT and TWIST
C
C .. Scalars in common block /TILTLOG/ ..
LOGICAL NUTWIST
COMMON /TILTLOG/NUTWIST
C&&*&& end_include ../inc/tiltlog.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
SAVE
C .. Data statements ..
C
C---- A0 and B0 define shape of bulge for vee films
C these values give 2% at x=3700 and y=6000
C
DATA A0/2.86E-7/,B0/2.78E-8/
C ..
C
C---- XMID, YMID are 10 micron coordinates of centre of image, needed
C for distortions ROFF and TOFF
C
C---- RSCAN is the radius of the scanner in 10 micron units
C
PI = 4.0*ATAN(1.0)
RSCAN = SQRT(RSCANSQ)
IF (RSCAN.EQ.0.0) RSCAN = 1.0
C
XMID = 0.5*REAL(NREC)/FACT
YMID = 0.5*REAL(IYLEN)/FACT
XM = X*COSOM0 - Y*SINOM0
YM = X*SINOM0 + Y*COSOM0
C
C
IF (VEE) THEN
C
C---- confusing choice of variable names
C BNEG=TWIST*XTOFD(*SIN(VEE))
C BPOS=BULGE*XTOFD(*SIN(VEE))
C XSHIFT=TILT*XTOFD(*TAN(VEE))
C
DOV2 = XTOFD/2
ABSX = ABS(X)
XDASH = ABSX - 4300.0
XD = (ABSX-DOV2)
XMP = XD*COSOM0 - Y*SINOM0
YMP = XD*SINOM0 + Y*COSOM0
XX = XDASH*XDASH*A0
YY = Y*Y*B0
FB = EXP(-XX-YY)
FR = FB*XMP
BY = FB*YMP
SB = CBAR*SINOM0
CB = CBAR*COSOM0
C
DISTOR = VTILT*X + VTWIST*Y + SIGN(1.0,X)*VVERT
C
C---- following 2 lines are version refining vee xshift parameter
C xc=xm*xtofra+xcen+absx*tilt
C yc=ym*xtofra*yscal+ycen+tilt*y*sign(1.0,x)
C
C---- following 2 lines are version refining vee twist parameter
C xc=xm*xtofra+xcen+tilt*x*y
C yc=ym*xtofra*yscal+ycen+tilt*y*y
C
C---- coords for refining tilt, twist and vert
C
XC = (XTOFRA+DISTOR)*XM + XCEN
YC = (XTOFRA+DISTOR)*YM*YSCAL + YCEN
C
IF (X.GE.0.0) THEN
C
C---- positive x
C
XC = XC - VBPOS*FR - CB
YC = YC - VBPOS*BY - SB
C
C---- negative x
C
ELSE IF (VALONGX) THEN
XC = XC - VBNEG*FR + CB
YC = VBNEG*BY + YC + SB
ELSE
XC = VBNEG*FR + XC + CB
YC = YC - VBNEG*BY + SB
END IF
ELSE
C
C---- PSI is the angle between a line joining the centre of rotation
C of the spiral scan to the spot and the scanner X axis (horizontal
C for Mar scanner).
C The centre of rotation is assumed to be the centre of the
C digitised image. The direct beam position cannot be used as it is
C not correct for an offset detector.
C
IF (((YCEN+YM-YMID).EQ.0.0).AND.((XCEN+XM-XMID).EQ.0)) THEN
PSI = 0.0
ELSE
PSI = ATAN2(YCEN+YM-YMID,XCEN+XM-XMID)
END IF
RAD = SQRT((XCEN+XM-XMID)**2+(YCEN+YM-YMID)**2)
CPSI = COS(PSI)
SPSI = SIN(PSI)
R = SQRT(X*X+Y*Y)
IF (IMGP) THEN
IF(NUTWIST)THEN
C
C---- Normalize components of ray to XTOFRA
C
XRED = X/XTOFD
YRED = Y/XTOFD
C ZRED = XTOFD/XTOFD
IF((DETNOR(1).EQ.0.0).AND.(DETNOR(2).EQ.0.0).AND.
$ (DETNOR(3).EQ.0.0))CALL ROTMAT2(DETNOR,TILT,TWIST)
DXTOF = 1.0/((XRED*DETNOR(1)) +
$ (YRED*DETNOR(2)) + DETNOR(3))
ELSE
DXTOF = TILT*X + XTOFRA + TWIST*Y
ENDIF
CURVE1 = RDTOFF*SIN(PI*NODES*RAD/RSCAN+TOFFPHI)
CURVE2 = RDROFF*SIN(PI*NODES*RAD/RSCAN+ROFFPHI)
XC = DXTOF*XM + XCEN - (TOFF+CURVE1)*SPSI +
+ (ROFF+CURVE2)*CPSI
YC = DXTOF*YM*YSCAL + YCEN + (TOFF+CURVE1)*CPSI +
+ (ROFF+CURVE2)*SPSI
ELSE
DXTOF = TILT*X + XTOFRA + TWIST*Y + BULGE*R
XC = DXTOF*XM + XCEN
YC = DXTOF*YM*YSCAL + YCEN
END IF
END IF
C
C
END
C== MMTOPX1 ==
C
SUBROUTINE MMTOPX1(XDET, YDET, YPIX, XPIX, ISTAT)
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C Convert predicted detector coordinates XDET, YDET in mm
C (relative to an origin at the detector normal position for zero
C swing angle) to image pixel coordinates XPIX, YPIX (slow, fast)
C
C
C YPIX, XPIX Image coordinates in pixels
C XDET, YDET Predicted coordinates in millimeters relative
C to detector normal at zero swing
C
INTEGER ISTAT
REAL XDET, YDET, YPIX, XPIX
C
C ..
C .. External Subroutines ..
EXTERNAL MMTOPX
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN,TAN
C ..
C .. Common blocks ..
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
REAL XDETMU,YDETMU,XGEN,YGEN,DTOR
DTOR = ATAN(1.0)*4.0/180.0
C
C---- Convert coordinates to 10 micron units
C
XGEN = XDET*100.0
YGEN = YDET*100.0
C
C---- Convert to an origin at the direct beam position
C
CAL IF (TWOTHETA.NE.0.0) YGEN = YGEN - XTOFD*TAN(TWOTHETA*DTOR)
C
C---- Now convert to MOSFLM virtual detector coordinate frame
C
XDET = XGEN*COSOM0 + YGEN*SINOM0
YDET = -XGEN*SINOM0 + YGEN*COSOM0
C
CALL MMTOPX(XDETMU,YDETMU,XDET,YDET)
YPIX = YDETMU*0.01*YSCAL/RAST
XPIX = XDETMU*0.01/RAST
C
C Check limits? ISTAT is 0 if reflection falls on the detector,
C ISTAT is -1 if the reflection does not.
C
ISTAT = 0
IF ( (YPIX .LT. 1.) .OR. (YPIX .GT. REAL(IYLEN-1))
+ .OR. (XPIX .LT. 1.) .OR. (XPIX .GT. REAL(NREC-1))) ISTAT = -1
RETURN
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE MODARRAY(IMODE,BGRAT,IRECG,LASTREC,INTPOST,
$ SIGPOST)
C =================================
C
C first LABEL 100, last 230: first FORMAT 7000, last 7160
C DEBUG(68) this subroutine
C
C Routine to create a set of arrays in which we can keep the
C book-keeping stuff for new style POSTREFINEMENT (using partials
C spread over several images).
C
C
C NGRA = maximum number of partials that make up a full.
C MGRA = maximum number of reflections that can be stored.
C MODE = what we are doing here
C = 0: initializing IXYHKL with -999 in IXYHKL(1,1:M)
C = 1: clearing out old values and packing to the top of the array,
C then
C sorting (called at end of every frame).
C = 2: adding a new record. Also checking to see if all parts are
C present
C and flagging if it's ready for postrefinement.
C
C IPARTS = array for the integer parts(Image number, KHF)
C IXYHKL = array to hold the indices (H, K, L)
C FPARTS = array to hold the real parts (I, SIGMAI, FRAC, PHIwidth)
C FXYHKL = array to hold the virtual film co-ordinates in mm (X, Y)
C the mappings are as follows;
C
C all the following from SPROCESS.F
C
C FXYHKL(1,JCOUNT) = X
C FXYHKL(2,JCOUNT) = Y
C FXYHKL(3,JCOUNT) = PHI
C FXYHKL(4,JCOUNT) = PHIW
C FXYHKL(5,JCOUNT) = BGRATIO (not used at present)
C
C IXYHKL(1,JCOUNT) = IHKL(1) = 9999 for an empty record
C IXYHKL(2,JCOUNT) = IHKL(2)
C IXYHKL(3,JCOUNT) = IHKL(3)
C
C IPARTS(1,JCOUNT,I) = IPAD*N+1 ! = KHF (N01) (IPAD=100)
C .lt. 0 for a reflection that is ready to be
C or has been passed to post-refinement.
C IPARTS(2,JCOUNT,I) = Image number = ID
C IPARTS(3,JCOUNT,I) = INTENS
C IPARTS(4,JCOUNT,I) = SIGINT
C
C FPARTS(JCOUNT,I) = FRAC
C
C note that with NGRA=20 and MGRA=30,000 we need 12.4 Mbyte for
C these arrays.
C
C On entry:
C INTPOST(1), SIGPOST(1) are used for passing intensity and sigma
C of current reflection from sprocess to modarray.
C
C On Exit:
C INTPOST(1) and INTPOST(2) are used to pass the intensities of the
C two
C "halves" of the partial, similarly SIGPOST for the SD's, back to
C SPROCESS
C so that they can be passed to POSTREFL.
C PHIPOST is the assigned phi for this partial
C FRCPOST(2) is 1 - FRCPOST(1)
C
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/comarray.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C Common bits for the big array handling for post refinement
C
C---- for passing the summed partials around different routines
C
INTEGER INTPOST(2),SIGPOST(2)
C
C---- COMMON BLOCK POSTPHI
C
REAL PHIPOST
COMMON /POSTPHI/ PHIPOST
C
C---- COMMON block /SUMPARTS/
C
INTEGER JCOUNT
COMMON /SUMPARTS/ JCOUNT
C
C---- COMMON block /IMAGENO/
C
INTEGER IMAGE_NUMBER
COMMON /IMAGENO/ IMAGE_NUMBER
C&&*&& end_include ../inc/comarray.f
C&&*&& include ../inc/modarray.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C bits that should only be accessed in modarray.f
C
C IPARTS = array for the integer parts(Image number, MPART)
C IXYHKL = array to hold the indices (H, K, L)
C FPARTS = array to hold the real parts (I, SIGMAI, FRcalc)
C FXYHKL = array to hold the film co-ordinates in mm & PHIW (X, Y, PHI and
C PHIwidth)
INTEGER IPARTS(4,MGRA,NGRA),IXYHKL(3,MGRA)
REAL FPARTS(MGRA,NGRA),FXYHKL(5,MGRA)
INTEGER IBIG,JBIG,KBIG
INTEGER IXBIG(MGRA),IYBIG(MGRA),IRECBIG(MGRA),NREFBIG
REAL INTENS,SIGINT,FRCALC,PHIWID
INTEGER ITEMP,JTEMP,KTEMP
C&&*&& end_include ../inc/modarray.f
C&&*&& include ../inc/reek_mod.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
REAL X,Y
INTEGER IHKL,KHF
COMMON /REEK_MOD/ X,Y,IHKL(3),KHF
C&&*&& end_include ../inc/reek_mod.f
C&&*&& include ../inc/film_no.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
integer id
common /film_num/ id
C&&*&& end_include ../inc/film_no.f
c include '../inc/mxdinc.f'
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/postchk.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file postchk.h
C---- START of include file postchk.h
C
C DELPHIV stores the missets for the first NADD images only,
C so that once NADD images have been processed their
C refined missets can be saved for writing to the
C summary file.
C
C .. Arrays in Common /POSTCHK/
REAL SDBEAM,SDCELL,SDDELPHI,DELPHIV,SHIFT
LOGICAL FCELL
C
C .. Scalars in Common /POSTCHK/ ..
C ..
REAL PRRES1,PRRES2,RESIDMAX,SDFAC,SHIFTMAX,SHIFTFAC,
+ ANGWIDTH,CELLSHIFT,FRACMIN,FRACMAX,FRCSHIFT
INTEGER PRNS,NREFPR,NADD,NRPT,IPRINTP,NPRMIN
LOGICAL USEBEAM,REFCELL
C ..
C .. Common block /POSTCHK/ ..
COMMON /POSTCHK/ SDBEAM(6),SDCELL(6),SDDELPHI(2*NIMAX),
+ DELPHIV(3*NIMAX),SHIFT(3),PRRES1,PRRES2,RESIDMAX,
+ SDFAC,SHIFTMAX,SHIFTFAC,ANGWIDTH,CELLSHIFT,
$ FRACMIN,FRACMAX,FRCSHIFT,
+ PRNS,NREFPR,NADD,NRPT,IPRINTP,
+ NPRMIN,FCELL(6),USEBEAM,REFCELL
C ..
C
C
C&&*&& end_include ../inc/postchk.f
C&&*&& include ../inc/postreek.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C common block so we don't have to recalculate values of FRAC, PHIW, PHI
C for new post-refinement
C
REAL PHI,PHIW,FRAC
COMMON /POSTREEK/ PHI,PHIW,FRAC
C&&*&& end_include ../inc/postreek.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C
C
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
INTEGER ICOUNT,KCOUNT,NCOUNT,NCOL,SAME_ID,JMAX
INTEGER IDUM,JDUM,NDBG,ICHK,NHKL
C
C---- Scalar arguments
C
INTEGER IRECG,LASTREC,IMODE
REAL BGRAT
C
C---- Local scalars
C
INTEGER I,II,J,K,L,IREASON,CURRENT_ID,NCOMPLETE,NREJECT,IHGR,
+ IKGR,ILGR,NTOOWIDE,NNONSEQ,NNEWNOTFP,NLAST,NPRINT,
+ IPART
REAL SUMINT,CHKPOST(3),FRCPOST(2)
LOGICAL LASTPART,NOTWARN,DUMPREF
SAVE
C
C .. Data statements ..
DATA NOTWARN/.TRUE./
C
C
C---- First check to see if IMODE is in the allowed range, else print
C error message and return with error
C
IERRFLG = 0
IF ((IMODE .LT. 0) .OR. (IMODE .GT. 2)) THEN
WRITE(IOUT,7000)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=7000)
ENDIF
IERRFLG = 1
RETURN
ENDIF
7000 FORMAT(1X,'IMODE is an invalid value - check the FORTRAN source')
C
C-----------------------------------------------------------------------
C
C ---- Initialize HKL array; if we find a large and negative value,
C we can
C put a new reflection in this location. Otherwise we have to look
C at
C the next location. Once a reflection has been passed for post
C -refinement,
C we reset this value to a larger negative number, e.g. -9999.
C
IF (IMODE.EQ.0) THEN
C
IF (DEBUG(68))THEN
WRITE(IOUT,FMT=7010)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=7010)
ENDIF
7010 FORMAT('MODARRAY initializing array for partials')
ENDIF
C
II = 0
K = 0
DO 110 I=1,MGRA,1
C
C---- only need to reset those elements which have changed
C
IF(IXYHKL(1,I).NE.9999)THEN
IXYHKL(1,I) = 9999
II = II + 1
DO 100 J=1,NGRA,1
IF(IPARTS(1,I,J).NE.0)THEN
IPARTS(1,I,J) = 0
K = K + 1
ENDIF
100 CONTINUE
ENDIF
110 CONTINUE
NHKL = 0
NLAST = 0
JMAX = 0
NCOMPLETE = 0
NREJECT = 0
NNONSEQ = 0
NNEWNOTFP = 0
IF(DEBUG(68))THEN
IF(ONLINE)WRITE(ITOUT,FMT=7015)II,K
WRITE(IOUT,FMT=7015)II,K
ENDIF
RETURN
7011 FORMAT(/,'IXYHKL(1,',I5,') was ',I5)
7012 FORMAT(' and it''s now..........',I5)
7013 FORMAT('IPARTS(',I5,',',I2,') was ',I5)
7014 FORMAT(' and it is now............',I5)
7015 FORMAT(132('*'),/,I5,' locations of the big array have been ',
$ 'zeroed including ',I5,' reflection locations',/,132('*'))
ENDIF ! end of IMODE = 0
C
C-----------------------------------------------------------------------
C
C ---- Check which reflections have been passed for post-refinement,
C push up
C the next active reflection into its place. This is called at
C the end of every image.
C
C
IF (IMODE.EQ.1) THEN
IF (DEBUG(68))THEN
WRITE(IOUT,FMT=7020) CURRENT_ID
IF (ONLINE) WRITE(ITOUT,FMT=7020) CURRENT_ID
7020 FORMAT('MODARRAY Checking which reflections have been sent',
$ /,'for post-refinement, and pushing up next ',
$ 'active reflection.'/,1X,'Current ID',I5)
NPRINT = MIN(NDEBUG(68),JMAX)
WRITE(IOUT,FMT=7244) ((IXYHKL(I,J),I=1,3),(IPARTS(1,J,L),
+ IPARTS(2,J,L),L=1,10),J=1,NPRINT)
IF (ONLINE) WRITE(IOUT,FMT=7244) ((IXYHKL(I,J),I=1,3),
+ (IPARTS(1,J,L),IPARTS(2,J,L),L=1,10),J=1,NPRINT)
7244 FORMAT(1X,'Before elimination',/,(1X,3I4,3X,10(I5,I4,2X)))
ENDIF
C
ICOUNT = 1
JCOUNT = 1
C
C---- the first unfilled record will have IXYHKL(1,ICOUNT) .eq. 9999, so
C ...
C
DO WHILE (IXYHKL(1,ICOUNT) .NE. 9999)
C
C---- i.e. this record isn't empty
C
C
C---- tidy up stray unfinished reflections. Check if current
C image is more than (reflection width in images) away
C from image number on which it started.
C
IF (CURRENT_ID-INT(ABS(IPARTS(1,ICOUNT,1)/IPAD))
$ .GT.IPARTS(2,ICOUNT,1)) THEN
IPARTS(1,ICOUNT,1) = -ABS(IPARTS(1,ICOUNT,1))
IF (DEBUG(68)) THEN
WRITE(IOUT,FMT=7210) (IXYHKL(I,ICOUNT),I=1,3),
+ FXYHKL(3,ICOUNT),ICOUNT,JCOUNT,
+ (IPARTS(1,ICOUNT,J), IPARTS(2,ICOUNT,J),J=1,6)
IF (ONLINE) WRITE(ITOUT,FMT=7210)
+ (IXYHKL(I,ICOUNT),I=1,3),FXYHKL(3,ICOUNT),
+ ICOUNT,JCOUNT,
+ (IPARTS(1,ICOUNT,J), IPARTS(2,ICOUNT,J),J=1,6)
END IF
7210 FORMAT(1X,' *** reflection ',3I5,' at phi=',F7.2,
+ ' rejected as finished, ICOUNT,JCOUNT ',2I5,/,1X,
+ 'KHF, ID for first 6 parts ',6(I4,I4,3X))
END IF
C
C----
C
IF (IPARTS(1,ICOUNT,1) .LT. 0) THEN
C
C---- i.e. this record contains information about a reflection that has
C been
C used already for post-refinement, so it can be overwritten with
C the next
C record
120 ICOUNT = ICOUNT + 1
C
C---- Need to check that this reflection is OK before storing it.
C
IF (IPARTS(1,ICOUNT,1) .LT. 0) GOTO 120
ENDIF
C
C---- this has to be kept for adding more parts, so push it up the stack
C
IXYHKL(1,JCOUNT) = IXYHKL(1,ICOUNT)
IXYHKL(2,JCOUNT) = IXYHKL(2,ICOUNT)
IXYHKL(3,JCOUNT) = IXYHKL(3,ICOUNT)
FXYHKL(1,JCOUNT) = FXYHKL(1,ICOUNT)
FXYHKL(2,JCOUNT) = FXYHKL(2,ICOUNT)
FXYHKL(3,JCOUNT) = FXYHKL(3,ICOUNT)
FXYHKL(4,JCOUNT) = FXYHKL(4,ICOUNT)
C
C---- Start looping across the parts of each reflection. Need to
C transfer all NGRA parts to overwrite any non-zero parts from
C the reflection that used to be stored at this position.
C
NCOUNT = 1
DO WHILE (NCOUNT.LT.NGRA)
IPARTS(1,JCOUNT,NCOUNT) = IPARTS(1,ICOUNT,NCOUNT)
IPARTS(2,JCOUNT,NCOUNT) = IPARTS(2,ICOUNT,NCOUNT)
IPARTS(3,JCOUNT,NCOUNT) = IPARTS(3,ICOUNT,NCOUNT)
IPARTS(4,JCOUNT,NCOUNT) = IPARTS(4,ICOUNT,NCOUNT)
FPARTS(JCOUNT,NCOUNT) = FPARTS(ICOUNT,NCOUNT)
NCOUNT = NCOUNT + 1
ENDDO
C WRITE(IOUT,FMT=7246) JCOUNT,ICOUNT,(IXYHKL(I,JCOUNT),
C + I=1,3), (IPARTS(1,JCOUNT,I),IPARTS(2,JCOUNT,I),I=1,10)
C 7246 FORMAT(1X,'JC=',I4,' IC=',I4,2x,3I4,10(2I4,3X))
C
ICOUNT = ICOUNT + 1
JCOUNT = JCOUNT + 1
ENDDO
C
C---- More debug
C
NHKL = JCOUNT - 1
NHKL = JCOUNT - 1
NLAST = NHKL
IF (DEBUG(68)) THEN
WRITE(IOUT,FMT=7200) ICOUNT,JCOUNT,ICOUNT-JCOUNT,
+ (IPARTS(1,I,1),I=1,JCOUNT)
IF (ONLINE) WRITE(ITOUT,FMT=7200) ICOUNT,JCOUNT,
+ ICOUNT-JCOUNT,(IPARTS(1,I,1),I=1,JCOUNT)
7200 FORMAT(/,/,1X,'After eliminating finished reflections',
+ ' ICOUNT,JCOUNT',2I6,' Number rejected',I5,/,
+ (1X,20I4/))
NPRINT = MIN(NDEBUG(68),NHKL)
WRITE(IOUT,FMT=7245) ((IXYHKL(I,J),I=1,3),(IPARTS(1,J,L),
+ IPARTS(2,J,L),FXYHKL(3,J),FPARTS(J,L),L=1,4),J=1,NPRINT)
IF (ONLINE) WRITE(ITOUT,FMT=7245) ((IXYHKL(I,J),I=1,3),
+ (IPARTS(1,J,L),IPARTS(2,J,L),FXYHKL(3,J),
+ FPARTS(J,L),L=1,4),J=1,NPRINT)
7245 FORMAT(1X,'After elimination',/,(1X,3I4,3X,
+ 4(I5,I4,F6.1,F5.2,2X)))
END IF
C
C--- Sort array on H,K,L indicies
C
CALL SORTPART(NHKL,FXYHKL,IXYHKL,FPARTS,IPARTS)
IF (DEBUG(68)) THEN
WRITE(IOUT,FMT=7240) NHKL
IF (ONLINE) WRITE(ITOUT,FMT=7240) NHKL
7240 FORMAT(1X,'Sorting',I5,' reflections on h,k,l in MODE=1')
C WRITE(IOUT,FMT=7242) ((IXYHKL(I,J),I=1,3),(IPARTS(1,J,L),
C + IPARTS(2,J,L),FXYHKL(3,J),FPARTS(J,L),L=1,4),J=1,NHKL)
C 7242 FORMAT((1X,3I4,3X,4(I5,I4,F6.1,F5.2,2X)))
END IF
C
C---- and now we reset values of IXYHKL(1,*) to 9999 ready for re
C -filling,
C and IPARTS(1,*,*) to 0.
C
DO 140 I=JCOUNT,MGRA,1
IXYHKL(1,I) = 9999
DO 130 J=1,NGRA,1
IPARTS(1,I,J) = 0
130 ENDDO
140 ENDDO
NDBG = 1
IF (DEBUG(68))THEN
IF(ONLINE)WRITE(ITOUT,7040)JCOUNT-1,NCOMPLETE,NREJECT,
+ NTOOWIDE,NNONSEQ,NNEWNOTFP
WRITE(IOUT,7040)JCOUNT-1,NCOMPLETE,NREJECT,NTOOWIDE,
+ NNONSEQ,NNEWNOTFP
7040 FORMAT(/,/,1X,80('*'),/,/,11X,I6,' locations of the big',
$ ' array contain reflection data',/,11X,I6,
$ ' reflections have been completed this image',/,
$ 11X,I6,' reflections have been rejected this cycle',
+ /,1X,I5,' reflections too wide (more than 20 parts)',
+ /,1X,I5,' reflections with non-sequential IDs',
+ /,1X,I5,' reflections where first occurence does not',
+ ' have first part present',
$ /,1X,80('*'),/,/)
ENDIF
NTOOWIDE = 0
NREJECT = 0
NCOMPLETE = 0
NNONSEQ = 0
NNEWNOTFP = 0
RETURN
C
C---- end of IMODE = 1
C
ENDIF
C
C-----------------------------------------------------------------------
C
C---- Add a reflection to the end of the list. This should be called for
C every
C partial reflection
C
IF (IMODE.EQ.2) THEN
KHF = IRG(IRECG)
LASTPART = .FALSE.
LASTREC = 0
C
IF (KHF.EQ.0) THEN
WRITE(IOUT,FMT=7230)
IF (ONLINE) WRITE(ITOUT,FMT=7230)
7230 FORMAT(1X,'*** modarray CALLED WITH KHF=0 !!!')
RETURN
ENDIF
NCOL = INT(KHF/IPAD)
IPART = KHF - IPAD*NCOL
C hrp18072000
C if partial spread over too many images...
IF (IPART.GT.NGRA) THEN
NTOOWIDE = NTOOWIDE +1
RETURN
END IF
IF (NCOL.EQ.IPART) LASTPART = .TRUE.
C
C---- reset reflection counter and sort array if new image
C
IF (SAME_ID .NE. ID) THEN
CURRENT_ID = ID
NDBG = 1
SAME_ID = ID
ENDIF
JCOUNT = 1
IHGR = IHG(IRECG)
IKGR = IKG(IRECG)
ILGR = ILG(IRECG)
C
C---- We have to count through the array until we find EITHER
C (1) 9999 in an H field (reflection unused so far) OR
C (2) 0 in a KHF field (this part of the reflection not used yet)
C
150 IF (JCOUNT.GT.MGRA) THEN
IF (NOTWARN) THEN
WRITE(IOUT,FMT=7260) MGRA
IF (ONLINE) WRITE(IOUT,FMT=7260) MGRA
NOTWARN = .FALSE.
END IF
RETURN
END IF
7260 FORMAT(///,1X,'***** SERIOUS PROBLEM *****',
+ /,1X,'Number of reflections to be stored for',
+ ' postrefinement exceeds limit of',I6,/,1X,
+ 'Need to recompile program increasing parameter',
+ ' MGRA.')
C
IF (JCOUNT.GT.NHKL) GOTO 180
C
C---- this reflection is already in the array
C
C---- check for exact match to HKL, i.e. this reflection has already had
C
C parts put into the array.
C
C-----For first NHKL reflections, which have already been sorted, can
C implement a stricter test, but for reflections beyond that
C
C---- Do first check on h, as array is sorted on this index
C
IF (IXYHKL(1,JCOUNT).LT.IHGR) THEN
JCOUNT = JCOUNT + 1
GOTO 150
END IF
C
C---- If next test true, must be a new reflection
C
IF (IXYHKL(1,JCOUNT).GT.IHGR) GOTO 180
C
IF (IXYHKL(2,JCOUNT).NE.IKGR) THEN
JCOUNT = JCOUNT + 1
GOTO 150
END IF
IF (IXYHKL(3,JCOUNT).NE.ILGR) THEN
JCOUNT = JCOUNT + 1
GOTO 150
END IF
C
C---- all indices match
C
C---- checks on validity of KHF
C
C---- this part of the reflection is already here.This can happen if
C the change in missets has resulted in a change in the sequence
C of KHF flags. Make sure that the ID is not the same, ie this is
C not a repeat refinement.
C
IF ((IPARTS(1,JCOUNT,IPART) .GT. 0)
$ .AND. (IPARTS(1,JCOUNT,1).GT.0)
+ .AND.(IPARTS(2,JCOUNT,IPART).NE.ID)) THEN
IF (DEBUG(68)) THEN
WRITE(IOUT,FMT=7250) IHGR,IKGR,ILGR,
+ (IPARTS(1,JCOUNT,K),IPARTS(2,JCOUNT,K),K=1,10)
IF (ONLINE) WRITE(ITOUT,FMT=7250) IHGR,IKGR,ILGR,
+ (IPARTS(1,JCOUNT,K),IPARTS(2,JCOUNT,K),K=1,10)
7250 FORMAT(1X,'This part of relection',3I4,
+ ' already present',', KHF,ID..',10(I4,I4,3X))
END IF
C
C---- Set flag to show that this location in arrays in no longer needed.
C
IPARTS(1,JCOUNT,1) = -ABS(IPARTS(1,JCOUNT,1))
RETURN
ENDIF
C
C---- CHRP 13-Apr-2000 Don't add parts if the new bit isn't strictly
C sequential
C in image number. This can happen if a previous part
C was an overload, rejected as a badspot, off edge
C of detector, or if the change in missets has
C resulted in a change in the sequence of KHF flags.
C
IF (IPART.GT.1) THEN
IF ((ID-IPARTS(2,JCOUNT,IPART-1)).NE.1) THEN
NNONSEQ = NNONSEQ + 1
IF (DEBUG(68)) THEN
WRITE(IOUT,FMT=7252) IHGR,IKGR,ILGR,
+ ID,IPARTS(2,JCOUNT,IPART-1)
IF (ONLINE) WRITE(ITOUT,FMT=7252) IHGR,IKGR,ILGR,
+ ID,IPARTS(2,JCOUNT,IPART-1)
7252 FORMAT(1X,'Non sequential parts for relection',
+ 3I4,' Current ID',I4,' ID previous part',I4)
END IF
C
C---- Set flag to show that this location in arrays in no longer needed.
C
IPARTS(1,JCOUNT,1) = -ABS(IPARTS(1,JCOUNT,1))
RETURN
ENDIF
ENDIF
C
C---- Check -ve SD...should never happen
C
IF (SIGPOST(1).LE.0) THEN
WRITE(IOUT,FMT=7068) IHGR,IKGR,ILGR,
+ INTPOST(1),SIGPOST(1)
IF (ONLINE) WRITE(ITOUT,FMT=7068) IHGR,IKGR,ILGR,
+ INTPOST(1),SIGPOST(1)
7068 FORMAT(1X,'***** Serious error, reflection',3I5,
+ 'has negative SD. I,sd:',2I8)
RETURN
END IF
C
C---- JUST IN CASE A COUNTER HAS GONE AWRY
C
IF (IPART .GT. NGRA) THEN
WRITE(IOUT,FMT=7060)IPART,NGRA
IF (ONLINE) WRITE(ITOUT,FMT=7060)IPART,NGRA
7060 FORMAT('Programmer Error! Counter I reaches ',
$ 'impossible value!',/,'I = ',I5,
$ ' and NGRA = ',I5)
IERRFLG = 1
RETURN
ENDIF
C
C---- put it in the right location, remembering that the first free slot
C will be
C for I=2.
C
IPARTS(1,JCOUNT,IPART) = IRG(IRECG)
IPARTS(2,JCOUNT,IPART) = ID
IPARTS(3,JCOUNT,IPART) = INTPOST(1)
IPARTS(4,JCOUNT,IPART) = SIGPOST(1)
FPARTS(JCOUNT,IPART) = FRACG(IRECG)
C-----------------------------------------------------------------------
IF ((DEBUG(68)).AND.(NDEBUG(68).GE.NDBG))THEN
WRITE(IOUT,FMT=7070)(IXYHKL(II,JCOUNT),II=1,3),
$ (FXYHKL(II,JCOUNT),II=1,4),FPARTS(JCOUNT,1),
$ (IPARTS(II,JCOUNT,1),II=1,4),JCOUNT
IF (ONLINE) THEN
WRITE(ITOUT,FMT=7070)(IXYHKL(II,JCOUNT),II=1,3),
$ (FXYHKL(II,JCOUNT),II=1,4),FPARTS(JCOUNT,1),
$ (IPARTS(II,JCOUNT,1),II=1,4),JCOUNT
ENDIF
DO 160 IDUM=2,IPART,1
WRITE(IOUT,FMT=7080)(IXYHKL(II,JCOUNT),II=1,3),
$ (FXYHKL(II,JCOUNT),II=1,4),FPARTS(JCOUNT,IDUM),
$ (IPARTS(II,JCOUNT,IDUM),II=1,4),JCOUNT
IF (ONLINE) THEN
WRITE(ITOUT,FMT=7080)(IXYHKL(II,JCOUNT),II=1,3),
$ (FXYHKL(II,JCOUNT),II=1,4),FPARTS(JCOUNT,IDUM),
$ (IPARTS(II,JCOUNT,IDUM),II=1,4),JCOUNT
ENDIF
160 ENDDO
7070 FORMAT(1X,'H,K,L = ',3(I3,1X),' X,Y = ',F10.3,
+ 1X,F10.3,', Phi,PhiW = ',f8.4,1x,f7.4,
+ ' Frc = ',
+ f7.4,' KHF = ',I4,' Film # ',I4,1X,'I,sig(I) = ',
+ I7,I5,' slot = ',I5)
7080 FORMAT(' ',3(I3,1X),' ',F10.3,1X,
+ F10.3,', ',f8.4,1x,f7.4,
+ ', ',
+ f7.4,' ',I4,' ',I4,12X,I7,I5,8X,I5)
ENDIF
C-----------------------------------------------------------------------
NDBG = NDBG + 1
GOTO 200
C
C---- This is a new reflection {(IXYHKL(1,JCOUNT).EQ.9999)}
C---- checks on validity of KHF; if this isn't the first part of a
C partial,
C
180 IF (IPART .GT. 1) THEN
NNEWNOTFP = NNEWNOTFP + 1
IF (DEBUG(68)) THEN
WRITE(IOUT,FMT=7082) IHGR,IKGR,ILGR,IPART
IF (ONLINE) WRITE(ITOUT,FMT=7082) IHGR,IKGR,ILGR,IPART
7082 FORMAT(1X,'New reflection',3I4,' does not have first',
+ ' part, IPART=',I3)
END IF
RETURN
ENDIF
C
C---- okay, we can add it in the first free slot as this location is
C empty
C
JCOUNT = NLAST + 1
NLAST = JCOUNT
FXYHKL(1,JCOUNT) = XG(IRECG)
FXYHKL(2,JCOUNT) = YG(IRECG)
FXYHKL(3,JCOUNT) = PHIG(IRECG)
FXYHKL(4,JCOUNT) = PHIWG(IRECG)
IXYHKL(1,JCOUNT) = IHG(IRECG)
IXYHKL(2,JCOUNT) = IKG(IRECG)
IXYHKL(3,JCOUNT) = ILG(IRECG)
IPARTS(1,JCOUNT,1) = IRG(IRECG)
IPARTS(2,JCOUNT,1) = ID
IPARTS(3,JCOUNT,1) = INTPOST(1)
IPARTS(4,JCOUNT,1) = SIGPOST(1)
FPARTS(JCOUNT,1) = FRACG(IRECG)
C
C---- 08062000
C---- now make sure all the other parts of this reflection location
C are zeroed.
C
DO 190 I=2,NGRA,1
IPARTS(1,JCOUNT,I) = 0
IPARTS(2,JCOUNT,I) = 0
IPARTS(3,JCOUNT,I) = 0
IPARTS(4,JCOUNT,I) = 0
FPARTS(JCOUNT,I) = 0.0
190 ENDDO
IF ((DEBUG(68)).AND.(NDEBUG(68).GE.NDBG))THEN
WRITE(IOUT,FMT=7070)(IXYHKL(II,JCOUNT),II=1,3),
$ (FXYHKL(II,JCOUNT),II=1,4),FPARTS(JCOUNT,1),
$ (IPARTS(II,JCOUNT,1),II=1,4),JCOUNT
IF (ONLINE) THEN
WRITE(ITOUT,FMT=7070)(IXYHKL(II,JCOUNT),II=1,3),
$ (FXYHKL(II,JCOUNT),II=1,4),FPARTS(JCOUNT,1),
$ (IPARTS(II,JCOUNT,1),II=1,4),JCOUNT
ENDIF
ENDIF
JMAX = JCOUNT
RETURN
ENDIF
C
C---- Check to see if this reflection should be passed to post
C -refinement
C
200 IF (LASTPART) THEN
C
C---- Set flag to show that this location in arrays in no longer needed.
C
IPARTS(1,JCOUNT,1) = -ABS(IPARTS(1,JCOUNT,1))
C
C---- Check that each part of the reflection has had KHF assigned
C properly so
C that we have contiguity (e.g. 401, 402, 403, 404) and that the
C parts
C come on sequential images.
C
SUMINT = FPARTS(JCOUNT,NCOL)
KTEMP = ID
IREASON = 0
DO 204 IDUM = NCOL-1,1,-1
KTEMP = KTEMP - 1
SUMINT = SUMINT + FPARTS(JCOUNT,IDUM)
IF (KTEMP .NE. IPARTS(2,JCOUNT,IDUM))
+ IREASON = IREASON + 2
204 ENDDO
C
C
C
C---- Reflection is spread over > 2 images, so have to check that the
C intensity
C for each part and for the total is not zero, to prevent a DBZ
C later...
C
C---- chkpost(1) is summed I for first NCOL/2 parts divided by total I
C---- chkpost(2) is summed I for first (NCOL/2+1) parts divided by total
C I
C---- chkpost(3) is summed intensity for all parts
CHKPOST(1) = 0.0
CHKPOST(2) = 0.0
CHKPOST(3) = 0.0
ICHK = NCOL/2
DO 210 JDUM=1,ICHK,1
CHKPOST(1) = CHKPOST(1) + IPARTS(3,JCOUNT,JDUM)
210 ENDDO
CHKPOST(3) = CHKPOST(1)
DO 215 JDUM=ICHK+1,NCOL,1
CHKPOST(3) = CHKPOST(3) + IPARTS(3,JCOUNT,JDUM)
215 ENDDO
C
IF(CHKPOST(3).GT.0.0)THEN
CHKPOST(1) = CHKPOST(1)/CHKPOST(3)
CHKPOST(2) = CHKPOST(1)
$ + FLOAT(IPARTS(3,JCOUNT,ICHK+1))/CHKPOST(3)
ELSE
IREASON = IREASON + 1
ENDIF
C
C---- Check that the summed intensity is in some sensible range, e.g. 0
C .9 to 1.1
C
c hrp if((sumint.lt.0.9).or.(sumint.gt.1.1).and.(ireason.lt
C .4))then
c hrp ireason = ireason + 4
c hrp endif
C
C---- Set flag for bad reflection and write out warning messages if
C IREASON .NE. 0
C
IF (IREASON.GT.0)THEN
NREJECT = NREJECT + 1
IF((DEBUG(68)).AND.(NDEBUG(68).GE.NDBG))THEN
WRITE(ITOUT,7090)(IXYHKL(IDUM,JCOUNT),
$ IDUM=1,3),IREASON
IF(ONLINE)WRITE(IOUT,7090)(IXYHKL(IDUM,JCOUNT),
$ IDUM=1,3),IREASON
ENDIF
7090 FORMAT('Reflection ',3i4,' has been rejected because:',
$ /,50X,'IREASON is ',I1)
C
IF(IREASON.GE.2)THEN
IF((DEBUG(68)).AND.(NDEBUG(68).GE.NDBG))THEN
WRITE(ITOUT,7110)(IPARTS(2,JCOUNT,IDUM),IDUM=1,10)
IF(ONLINE)WRITE(IOUT,7110)(IPARTS(2,JCOUNT,IDUM),
$ IDUM=1,10)
ENDIF
7110 FORMAT(50X,'The images are not strictly sequential: ',
$ 10I4)
ENDIF
C
IF(MOD(IREASON,2).NE.0)THEN
IF((DEBUG(68)).AND.(NDEBUG(68).GE.NDBG))THEN
WRITE(ITOUT,7120)(CHKPOST(IDUM),IDUM=1,3)
IF(ONLINE)WRITE(IOUT,7120)(CHKPOST(IDUM),IDUM=1,3)
ENDIF
7120 FORMAT(50X,'The intensity is Zero or Negative',
$ 3F12.2)
ENDIF
ELSE
C
C---- FLAG the reflection as ready for postrefinement for SPROCESS....
C
LASTREC = IRECG
IF((DEBUG(68)).AND.(NDEBUG(68).GE.NDBG))THEN
WRITE(IOUT,7130)(IXYHKL(IDUM,JCOUNT),
$ IDUM=1,3)
IF(ONLINE)WRITE(ITOUT,7130)(IXYHKL(IDUM,JCOUNT),
$ IDUM=1,3)
ENDIF
7130 FORMAT('Reflection ',3i4,' has been passed as OKAY for',
$ ' post-refinement')
NCOMPLETE = NCOMPLETE + 1
C
IF(IXYHKL(1,JCOUNT).EQ.9999) THEN
WRITE(IOUT,FMT=7270)
IF (ONLINE) WRITE(IOUT,FMT=7270)
7270 FORMAT(1X,'***** Serious programming error, have got',
+ ' a stored reflection with h=9999')
END IF
C
C---- Now test to see which parts go into which half of the reflection
C for
C passing to POSTREFL (PHIPOST and FRCPOST)
C
IF (KHF.EQ.202) THEN
C
C---- Reflection is spread over two images only; this is the trivial
C case
C
INTPOST(1) = IPARTS(3,JCOUNT,1)
SIGPOST(1) = IPARTS(4,JCOUNT,1)
FRCPOST(1) = FPARTS(JCOUNT,1)
INTPOST(2) = IPARTS(3,JCOUNT,2)
SIGPOST(2) = IPARTS(4,JCOUNT,2)
FRCPOST(2) = FPARTS(JCOUNT,2)
PHIPOST = PHIBEG
IMAGE_NUMBER = ID - 1
ELSE
C
C---- Reflection is spread over > 2 images (vide supra for checks)
C
IF (ABS(CHKPOST(1)-0.5) .GT. ABS(CHKPOST(2)-0.5))
$ ICHK=ICHK+1
PHIPOST = PHIBEG -(NCOL - ICHK -1)*(PHIEND-PHIBEG)
&
C
C---- Now loop round adding up the parts of the reflections into two
C components
C
INTPOST(1) = 0
SIGPOST(1) = 0
FRCPOST(1) = 0.0
INTPOST(2) = 0
SIGPOST(2) = 0
FRCPOST(2) = 0.0
IMAGE_NUMBER = ICHK
DO 220 IDUM=1,ICHK,1
INTPOST(1) = INTPOST(1) + IPARTS(3,JCOUNT,IDUM)
SIGPOST(1) = SIGPOST(1) + IPARTS(4,JCOUNT,IDUM)**2
FRCPOST(1) = FRCPOST(1) + IPARTS(3,JCOUNT,IDUM)
220 ENDDO
SIGPOST(1) = SQRT(FLOAT(SIGPOST(1)))
DO 230 IDUM = ICHK+1,NCOL,1
INTPOST(2) = INTPOST(2) + IPARTS(3,JCOUNT,IDUM)
SIGPOST(2) = SIGPOST(2) + IPARTS(4,JCOUNT,IDUM)**2
C HRP14042000 FRCPOST(2) = FRCPOST(2) + IPARTS(3
C ,JCOUNT,IDUM)
230 ENDDO
SIGPOST(2) = SQRT(FLOAT(SIGPOST(2)))
FRCPOST(1) = FRCPOST(1)/CHKPOST(3)
FRCPOST(2) = 1.0-FRCPOST(1)
ENDIF
IF (DEBUG(68).AND.(NDBG .LE. NDEBUG(68)))THEN
WRITE(IOUT,FMT=7150)
$ NCOL,PHIPOST,(INTPOST(II),SIGPOST(II),
$ FRCPOST(II),II=1,2)
IF(ONLINE)WRITE(ITOUT,FMT=7150)
$ NCOL,PHIPOST,(INTPOST(II),SIGPOST(II),
$ FRCPOST(II),II=1,2)
ENDIF
7150 FORMAT('Reflection is spread over ',i2,
$ ' images, centred at Phipost = ',F8.4,' I,sig(I),',
$ 'Frac [1]: ',2I6,1X,F8.6,1X,' I,sig(I),',
$ 'Frac [2]: ',2I6,1X,F8.6,1X)
ENDIF
NDBG = NDBG + 1
RETURN
C
C---- end of IMODE = 2
C
ENDIF
RETURN
END
C== MOSDATA ==
C
BLOCK DATA MOSDATA
C ==================
IMPLICIT NONE
C
C---- Errors this contains type conversions in data statements
C Real to Integer (eg CUTOFF) made integer
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Common blocks ..
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/params.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file params.h
C---- START of include file params.h
C
C
C .. Scalars in common block /PARAMS/ ..
INTEGER NSDR
C ..
C .. Common Block /PARAMS/ ..
COMMON /PARAMS/NSDR
C ..
C
C
C
C&&*&& end_include ../inc/params.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/parm2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm2.h
C---- START of include file parm2.h
C
C
C .. Scalars in common block /PARM2/ ..
REAL PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2
LOGICAL PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,PUPDATE,PKONLY,DENSE,PRFULLS,
+ DECONV
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
INTEGER IHD
C ..
C .. Common Block /PARM2/ ..
COMMON /PARM2/PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,
$ PKWDLIM3,PKWDOUTL,
$ ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2,
$ IHD(3,50),
$ PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,
+ PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,
+ PUPDATE,PKONLY,DENSE,
+ PRFULLS,DECONV
C ..
C
C
C&&*&& end_include ../inc/parm2.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/postchk.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file postchk.h
C---- START of include file postchk.h
C
C DELPHIV stores the missets for the first NADD images only,
C so that once NADD images have been processed their
C refined missets can be saved for writing to the
C summary file.
C
C .. Arrays in Common /POSTCHK/
REAL SDBEAM,SDCELL,SDDELPHI,DELPHIV,SHIFT
LOGICAL FCELL
C
C .. Scalars in Common /POSTCHK/ ..
C ..
REAL PRRES1,PRRES2,RESIDMAX,SDFAC,SHIFTMAX,SHIFTFAC,
+ ANGWIDTH,CELLSHIFT,FRACMIN,FRACMAX,FRCSHIFT
INTEGER PRNS,NREFPR,NADD,NRPT,IPRINTP,NPRMIN
LOGICAL USEBEAM,REFCELL
C ..
C .. Common block /POSTCHK/ ..
COMMON /POSTCHK/ SDBEAM(6),SDCELL(6),SDDELPHI(2*NIMAX),
+ DELPHIV(3*NIMAX),SHIFT(3),PRRES1,PRRES2,RESIDMAX,
+ SDFAC,SHIFTMAX,SHIFTFAC,ANGWIDTH,CELLSHIFT,
$ FRACMIN,FRACMAX,FRCSHIFT,
+ PRNS,NREFPR,NADD,NRPT,IPRINTP,
+ NPRMIN,FCELL(6),USEBEAM,REFCELL
C ..
C
C
C&&*&& end_include ../inc/postchk.f
C&&*&& include ../inc/praccum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file praccum.h
C---- START of include file praccum.h
C
C
C ..
C .. Arrays in common block /PRACCUM/ ..
REAL PRDATA
C
C .. Scalars in common block /PRACCUM/ ..
LOGICAL ACCUMULATE,FIRSTPASS,SECONDPASS,THIRDPASS,FIRSTFILM,
+ NOTREAD
C ..
C .. Common Block /PRACCUM/ ..
COMMON /PRACCUM/PRDATA(4,50),ACCUMULATE,FIRSTPASS,SECONDPASS,
+ THIRDPASS,FIRSTFILM,NOTREAD
C ..
C
C
C&&*&& end_include ../inc/praccum.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C&&*&& include ../inc/sys.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sys.h
C---- START of include file sys.h
C
C
C .. Scalars in Common Block /SYS/ ..
INTEGER ISYS
C ..
C .. Arrays in Common Block /SYS/ ..
INTEGER KSYS
C ..
C .. Common Block /SYS/ ..
COMMON /SYS/ISYS,KSYS(3)
C ..
C
C
C&&*&& end_include ../inc/sys.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
C ..
SAVE
C .. Data statements ..
C
C---- Defaults for common /CELL/
C
DATA UMAT/1.0,0.0,0.0, 0.0,1.0,0.0, 0.0,0.0,1.0/
C
C
C---- Defaults for common /GRAPHICS/
C
DATA NGR/7/,DISPLAY/32.0/,NLI/34/
C
C---- defaults for common /ORI/
C
DATA PBULGE/0.3/
C
C---- defaults for common /TGEN/
C
DATA OSCMIN/0.2/,OSCMAX/5.0/,XOVER/0.0,0.0/,PHSTEP/5.0/,
+ OSCANG/0.0/,TESTGEN/.FALSE./
C
C---- Defaults for /MCS/
C
DATA CURV/0.0/
C
C---- defaults for common /MYPROF/
C
DATA TOL/0.01/,IBOUND/6/,PROPT/.TRUE./,FIXBOX/.TRUE./,
+ BGPKRAT/2.0/,FRACREJ/0.5/,BADTOL/0.05/,ITRIM/0/,
+ NOVERLAP/1/,TOLMIN/0.010/,PROPTCEN/.TRUE./,RECOVER/.TRUE./,
+ RECLEVEL/5.0/,NOFIXBOX/.FALSE./
C
C---- defaults for common /PARAMS/
C
DATA NSDR/8/
C
C---- Set defaults for parameters in /PARM2/
C
DATA PRBGSIG/99.0/,ISDRATIO/2/,PRCUTOFF/65000/,
+ RMSBGPR/10.0/,NRFMIN/10/,WEIGHT/.TRUE./,USEOVRLD/.FALSE./,
+ USEDGE/.FALSE./,IPLOT/0/,WTPROFILE/.TRUE./,
+ CHANGEMASK/.TRUE./,PROFILE/.TRUE./,PRREAD/.FALSE./,
+ PRSAVE/.FALSE./,VARPRO/.TRUE./,NHKLD/0/,
+ DISCRIMINATE/.FALSE./,PKWDLIM1/20.0/,PKWDLIM2/20.0/,
+ PKWDLIM3/1000.0/,PUPDATE/.FALSE./,PKONLY/.FALSE./,
+ DENSE/.FALSE./,PKWDOUTL/0.0/,IOUTL1/0/,IOUTL2/0/,
+ DECONV/.FALSE./
C
C---- defaults for common /PRACCUM/
C
DATA ACCUMULATE/.TRUE./
C
C---- defaults for common /CONDATA/
C
DATA RMSLIM/50.0/,XMID/20.0/,ITHRESHF/100/,
+ THFOIL/0.0,0.0,0.0/,NSIG/6/,IRFMIN/40/,IRFINC/10/,IXSHIFT/0/,
+ IYSHIFT/0/,READCC/.FALSE./,FINDCC/.FALSE./,LIMIT/4500/,
+ VLIM/4000/,NOFID/.FALSE./,INTERPOL/.TRUE./,CONVOL/.FALSE./,
+ USEOVR/.FALSE./,USEPAR/.FALSE./,PRPART/.FALSE./,NCYC/2/,
+ SEP/2.0/,THICK/20/,FIXED/.FALSE./,PTMIN/0.5/,REFREJ/3.0/,
+ ADDPART/.FALSE./,SUMPART/.FALSE./,POSTREF/.FALSE./,
+ RWEIGHT/.TRUE./,USEBOX/.TRUE./,WRMSLIM/5.0/,MINREF/20/,
+ FIXSWAP/.FALSE./,PRFULLS/.FALSE./,LPREF/.FALSE./,
+ LPINTG/.FALSE./,INEWMAT/0/,IPTIME/5/,FULLFRAC/0.333/,
+ NSERTOT/0/,DISPMENU/.FALSE./,TEMPLATE/.FALSE./,
+ LOVERLAP/.FALSE./,ALLOUT/.FALSE./,NOLP/.FALSE./,
+ MULTIMTZ/.FALSE./,WTIME/1.0/,NOBACK/.FALSE./,
+ NEWPREF/.TRUE./
C
C---- defaults for common /CCONDATA/
C
DATA FDISK/' ',' ',' ',' ',' ',' ',' ',' ',' ',' '/,ODEXT/' '/
DATA IDENT/' '/,SPGNAM/'U'/
DATA INLINE/1000*' '/,SEPCHAR/'_'/
C
C---- defaults for common /AMATCH/
C
DATA NCYCA/2/,ARMSLIM/25.0/,RESOL1/6.0/,RESOL2/0.0/,RCONV/1.0/,
+ OVRLAP/1.0/,AELIMIT/25.0/,NSTEP/4/,SECANGLE/90.0/,
+ NOCENT/.FALSE./,NPASS/2/,DAMP/0.25/,ETAMAX/1.0/,
+ NOREFINE/.FALSE./,NBEAM/1/,AWRMSLIM/6.0/
C
C---- defaults for common /PEL/ (ISTART moved from OPENODS)
C
DATA INCORE/.TRUE./,ISTART/0/
C
C---- defaults for common /REPRT/
C
DATA IRANGE/-30,0,50,100,200,400,800,1600,3200/
DATA SDMON/5.0/
DATA PKACCEPT/.FALSE./
DATA RESCUT /0.0/
C
C---- defaults for common /PARM1/
C GRADMAX... Maximum allowed (background gradient)/(average background)
C for spots in spot integration.
C GRADMAXR.. Maximum allowed (background gradient)/(average background)
C for spots in spot refinement
C BGFREJ... Maximum allowed fraction of background pixels to be
C rejected for spots used in distortion refinement. This
C is not used in spot integration (see NBGMIN)
C
DATA CUTOFF/100000/,EFAC/-999.0/,EFACSQ/0.0/,NOVPIX/0/
DATA BGFREJ/0.5/,GRADMAX/0.03/,GRADMAXR/0.03/
DATA BGRAT/3.0/,PKRAT/3.5/,BGSIG/3.0/
DATA BADPLOT/.FALSE./,BADPLOT2/.FALSE./,RESD/0.0/RESDLOW/0.0/
C
C---- Every 100th reflection to be dumped if DUMP REFL specified,
C subject to intensity gt IDUMP=0 by default, and maximum
C number of MXDUMP reflections dumped
C
DATA NDUMP/100/,IDUMP/0/,MXDUMP/100/,IDMIN/-100000/
DATA IDMAX/10000000/
C
C
C--- Defaults for /LMB/, note adc offset now default value is 8
C
DATA ISCAL/1/,IDIVIDE/8/,ICONST/0/,NULLPIX/0/
DATA MACHINE/'MAR '/,MODEL/' '/
DATA SPIRAL/.TRUE./, ORTHOG/.FALSE./, CIRCULAR/.TRUE./
DATA TILED/.FALSE./
C ..
C
C--- Defaults for /BACKG/, deals with background pixel rejection
C NBGMIN... Minimum number of background pixels (after rejection)
C allowed for spot integration or in a standard profile
C (including average spot profile for image centre)
C
C BGFRAC... Fraction of background pixels to be used in initial
C determination of background plane.
C
DATA NBGMIN/10/,BGFRAC/0.8/
C
C---- Defaults for /POSTCHK/
DATA PRNS/0/,PRRES1/1.0/,PRRES2/0.0/,SDFAC/3.0/,
+ SHIFTMAX/0.05/,USEBEAM/.FALSE./,
+ FCELL/.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE.,.TRUE./,
+ IPRINTP/0/,ANGWIDTH/10.0/,SHIFTFAC/2.5/,NRPT/5/,
+ FRACMIN/0.05/,FRACMAX/0.95/,NPRMIN/20/
C
C---- Defaults for /REEKE/
DATA DELAMB/2.5E-3/,IMONO/0/,NWMAX/10/,DELCOR/0.0/,IPAD/100/
C
C---- Defaults for /SYS/
DATA KSYS/1,1,1/,ISYS/0/
C
C---- Defaults for /RAS/
DATA MINT/300/
C
C
C---- Defaults for /STRAT/
C
DATA AUTO/.FALSE./,SIZESET/.FALSE./,AUTANOM/.FALSE./
DATA NSEGAUTO/1/,NSTRAT/0/,CELLSCAL/1.0/,SHRUNK/.FALSE./
DATA FIRSTRAT/.TRUE./,NLAST/1/,NNPACKS/0/,NLASTPACK/1/
DATA NEWSTRAT/.FALSE./,WAITINP/.FALSE./
C
C---- Defaults for /SPOTS/
C
DATA ITHRESH/20/
C
C---- Defaults for /SPOTS2/
C
DATA NBINR/5/,NBINT/8/,IBINLIM/50/,NPIXMIN/6/,NPIXMAX/250/
DATA CUTPIXMIN/0.5/,CUTPIXMAX/6.0/,CUTWXMIN/0.5/,CUTWXMAX/2.0/
DATA CUTWYMIN/0.5/,CUTWYMAX/2.0/,XOFFSET/0.0/,YOFFSET/0.0/
DATA XSPLIT/0.3/,YSPLIT/0.3/,THRESH/5.0/,NEWSPT/.FALSE./
DATA MEDWXSPOT/0/,MEDWYSPOT/0/,NIMAG/0/
DATA SCALSRCH/0.02/,NSEARCH/10/,ISAFE/2/
DATA SPXMIN/0.0/, SPYMIN/0.0/,THRESHMAX/50.0/
C
C---- Defaults for /DSPLYC/
C
DATA WINOPEN/.FALSE./,LHELP/.TRUE./
C
C---- Defaults for /SAVALL/ and /SAVALLC/
C
DATA IISCN/.FALSE./,IISITE/.FALSE./,IIWAVE/.FALSE./
DATA IIDIV/.FALSE./,IIDISP/.FALSE./,IINULL/.FALSE./
DATA IIRAST/.FALSE./,IISEP/.FALSE./,IIOVER/.FALSE./
DATA IIRES/.FALSE./,IIBACK/.FALSE./
DATA SAVMATSTR/'Not set '/,SAVENAM/'mosflm.inp'/
DATA SVSCN/'Not set'/,SVSITE/'Not set '/
DATA SAVMATNAM/'Not set'/
C
C---- Defaults for /IOOSUM/
C
DATA IOLINE /100*' '/
C
C---- Defaults for /HEADER/
C
DATA HNULLPIX/0/
END
C== MOSHLP ==
SUBROUTINE MOSHLP(STRHLP)
C =========================
C
C
CHARACTER*(*) STRHLP
C
C---- Now STRHLP is not used
C
C
CALL XCCPHLP('mosflm')
RETURN
END
C
C
C
SUBROUTINE MOVEIT(A,B,N)
C ========================
C
C Copy N items from A to B
C
IMPLICIT NONE
INTEGER I,N
REAL A(N),B(N)
C
DO 1,I=1,N
1 B(I)=A(I)
RETURN
END
C== MOVLAP ==
SUBROUTINE MOVLAP(MASK,NHX,NHY,IDX,IDY,ISEPX,ISEPY,ISEP,IOFFSET,
+ LMASK)
IMPLICIT NONE
C
C---- Determines which pixels in array MASK are overlapped by peak pixels in
C a neighbouring spot.
C MASK Peak background mask set up by SETMASK
C NHX Box half-width in X
C NHY Box half-width in Y
C IDX X coordinate (pixels) of overlapping spot
C IDY Y coordinate (pixels) of overlapping spot
C ISEPX Minimum separation in X for overlap
C ISEPY Minimum separation in Y for overlap
C ISEP The overlapping spot number, used in setting up LMASK
C IOFFSET Offset in pixels to get the pixel number in the overlapping
C spot pixel mask from the pixel number in the actual spot
C LMASK Set up to have values ISEP for overlapped pixels, unless
C the value is already non-zero, in which case it is set to
C 100
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NHX,NHY,IDX,IDY,ISEPX,ISEPY,ISEP,IOFFSET
C ..
C .. Array Arguments ..
INTEGER MASK(MAXBOX),LMASK(MAXBOX)
C ..
C .. Local Scalars ..
INTEGER IJ,P,Q,IOD,NYY
C
IJ = 0
NYY = 2*NHY + 1
DO 20 P = -NHX,NHX
C
C---- Test for overlap
C
CAL IF (((IDX.GE.0).AND.((IDX - P).GT.ISEPX)) .OR.
CAL + ( (IDX.LE.0).AND.((IDX - P).LT.-ISEPX)) ) THEN
CAL
C---- Error in overlap test corrected 26/6/96
CAL IF ((IDX-P).GT.ISEPX) THEN
IF ((P.GT.(IDX+ISEPX)).OR.(P.LT.(IDX-ISEPX))) THEN
IJ = IJ + NYY
GOTO 20
END IF
DO 10 Q = -NHY,NHY
IJ = IJ + 1
C---- Error in overlap test corrected 26/6/96
IF ((Q.GT.(IDY+ISEPY)).OR.(Q.LT.(IDY-ISEPY))) GOTO 10
CAL
CAL IF ((IDY.GE.0).AND.((IDY - Q).GT.ISEPY)) GOTO 10
CAL IF ((IDY.LE.0).AND.((IDY - Q).LT.-ISEPY)) GOTO 10
CAL
C
C---- Test if this pixel in spot "J" is peak, if so flag it by
C setting LMASK non-zero, in fact set LMASK to the separation number
C ISEP, unless this pixel is overlapped by two or more spots in which
C case set it to 100
C
IF (MASK(IJ - IOFFSET).EQ.1) THEN
IF (LMASK(IJ).EQ.0) THEN
LMASK(IJ) = ISEP
ELSE
LMASK(IJ) = 100
END IF
END IF
C IF ((IDY.LT.0).AND.(MASK(IJ - IOFFSET).EQ.1))
C + WRITE(6,*),'reject pixel,p,q,IDX,IDY',P,Q,IJ,idx,idy
10 CONTINUE
20 CONTINUE
RETURN
END
C
C== MPARSE ==
C
C
C
SUBROUTINE MPARSE(LINE,IBEG,IEND,ITYP,FVALUE,IDEC,NTOK)
C ======================================================
C
C
C---- Finds the tokens in the character string LINE.
C Based on Mike Levitt's routine of the same name.
C Peter Brick 1-June-1983
C
C Modifications
C---- No Date Purpose -------------
C
C
C---- Tokens are strings separated by any of the delimiters = , ( ) ; or
C blank. The delimiters are ignored when they occur within a quoted
C string.
C
C---- If an unquoted exclamation mark (!) or a hash (#) occurs in a line
C then it and the rest of the line will be skipped.
C On entry LINE should contain the line to be parsed
C
C NTOK number of tokens found in LINE
C IBEG(I) start position of the i'th token in LINE
C IEND(I) end position of the i'th token in LINE
C ITYP(I) = 1 for alphanumeric tokens
C = 2 for numeric tokens
C = 3 for quoted tokens
C FVALUE(I) contains value of numeric tokens
C IDEC(I) token length if alphanumeric
C if token numeric it contains 100 if
C decimal point present
C + number of places after the decimal point
C
C---- Numeric tokens can be simple two argument signed arithmetic
C expressions or can contain the E notation (but cannot both contain
C two arguments and use the E notation).
C Valid examples are:
C 10, 10., 1.4-0.6, -1.32*-1.67, +1.45/-1, 1.7E-3
C
C
C
C .. Scalar Arguments ..
INTEGER NTOK
CHARACTER LINE* (*)
C ..
C .. Array Arguments ..
REAL FVALUE(40)
INTEGER IBEG(40),IDEC(40),IEND(40),ITYP(40)
C ..
C .. Local Scalars ..
REAL F10,SIGN,SIGN0,VALUE,VALUE0
INTEGER I,IDOT,J,LENLIM,NPLACE,OPER
LOGICAL BNUM,NUMBER,OPRATR,QUOTE,TOKEN,TQUOTE
CHARACTER OLDQUT,LETQT*2,DELIM*8,DIGS*16
C ..
C .. Local Arrays ..
INTEGER ISGN(2)
C ..
C .. External Functions ..
REAL MDOCAL
EXTERNAL MDOCAL
C ..
C .. Intrinsic Functions ..
INTRINSIC INDEX,LEN
C ..
C .. Data statements ..
DATA LETQT/'''"'/
DATA DELIM/' = , ();'/
DATA DIGS/'0123456789+-*/E.'/
DATA ISGN/1,-1/
C ..
C
C
DELIM(3:3) = CHAR(9)
LENLIM = LEN(LINE)
NTOK = 1
TOKEN = .FALSE.
VALUE = 0.0
OPRATR = .TRUE.
IDOT = 0
SIGN = 1.0
OPER = 0
OLDQUT = ' '
QUOTE = .FALSE.
TQUOTE = .FALSE.
NUMBER = .FALSE.
BNUM = .FALSE.
NPLACE = 0
C
C---- Start of main character counter loop
C
DO 10 I = 1,LENLIM
C
C---- Skip rest of LINE if ! or #
C
IF (.NOT.QUOTE .AND.
+ ((LINE(I:I).EQ.'!').OR.(LINE(I:I).EQ.'#'))) THEN
GO TO 20
ELSE
C
C---- Check for quotation mark
C
J = INDEX(LETQT,LINE(I:I))
C
C---- We have a quotation mark
C
IF (J.GT.0) THEN
C
C---- No previous quote
C
IF (OLDQUT.EQ.' ') THEN
C
OLDQUT = LETQT(J:J)
QUOTE = .TRUE.
C
C---- Previous matching quote
C
ELSE IF (OLDQUT.EQ.LETQT(J:J)) THEN
C
OLDQUT = ' '
QUOTE = .FALSE.
C
END IF
C
C---- On to next character
C
ELSE
C
C---- Check for a delimiter
C
J = INDEX(DELIM,LINE(I:I))
C
IF (.NOT. (.NOT.QUOTE) .OR. (J.EQ.0) .AND.
+ (I.LE.LENLIM)) THEN
C
C
C---- ie if ( quote .OR. (token .AND. (.NOT.number)) )
C
C---- Skip number processing
C
IF ((.NOT.QUOTE) .AND. (((.NOT.TOKEN)).OR. (((NUMBER).OR.
+ (BNUM))))) THEN
C
C---- Check for digit or +,-,E,/ etc
C
J = INDEX(DIGS,LINE(I:I))
C
C
IF (J.EQ.0) THEN
C
C---- Not 0-9,+,-,*,E,/
C
NUMBER = .FALSE.
C
ELSE IF (J.LE.10) THEN
C
C---- We have a digit
C
NUMBER = .TRUE.
BNUM = .FALSE.
IF (IDOT.EQ.0) THEN
VALUE = (J-1) + VALUE*10
ELSE IF (IDOT.EQ.1) THEN
VALUE = (J-1)*F10 + VALUE
F10 = F10*0.1
NPLACE = NPLACE + 1
END IF
OPRATR = .FALSE.
C
ELSE IF (OPRATR .AND. ((J.EQ.11).OR. (J.EQ.12))) THEN
C
C---- Opratr is true and we have a + or -
C
BNUM = .TRUE.
OPRATR = .FALSE.
SIGN = ISGN(J-10)
C
ELSE IF (J.GE.11 .AND. J.LE.15) THEN
C
C---- We have an operator
C
NUMBER = .TRUE.
BNUM = .FALSE.
IF (OPRATR .OR. (OPER.NE.0)) NUMBER = .FALSE.
C
C---- Can't have 2 operators in one number
C
C---- store 1st number
C
VALUE0 = VALUE
SIGN0 = SIGN
OPER = J - 10
VALUE = 0.0
SIGN = 1.0
IDOT = 0
OPRATR = .TRUE.
C
ELSE IF (J.EQ.16) THEN
C
C---- We have a decimal point
C
NUMBER = .TRUE.
BNUM = .FALSE.
IDOT = IDOT + 1
NPLACE = 0
F10 = 0.1
IF (IDOT.EQ.2) NUMBER = .FALSE.
C
C---- Not a number if 2 points in token
C
OPRATR = .FALSE.
C
END IF
END IF
C
C---- End of number processing
C
IF (.NOT.TOKEN) THEN
TOKEN = .TRUE.
IBEG(NTOK) = I
IF (QUOTE) TQUOTE = .TRUE.
END IF
C
C---- ie if( quote.OR.( (J.eq.0).and.(I.le.lenlim) ) )
C
C---- Onto next character
C
ELSE IF ((TOKEN)) THEN
C
C---- We have a token and a delimiter
C
C---- End of a numeric token
C
IF (NUMBER) THEN
C
ITYP(NTOK) = 2
IEND(NTOK) = I - 1
FVALUE(NTOK) = VALUE*SIGN
IF (OPER.GT.0) FVALUE(NTOK) = MDOCAL(FVALUE(NTOK),OPER,
+ SIGN0*VALUE0)
IDEC(NTOK) = 100*IDOT + NPLACE
ELSE
C
C---- End of a non-numeric token
C
C
IF (TQUOTE) THEN
ITYP(NTOK) = 3
IEND(NTOK) = I - 2
ELSE
ITYP(NTOK) = 1
IEND(NTOK) = I - 1
END IF
IDEC(NTOK) = IEND(NTOK) - IBEG(NTOK) + 1
END IF
C
NTOK = NTOK + 1
TOKEN = .FALSE.
VALUE = 0.0
OPRATR = .TRUE.
IDOT = 0
SIGN = 1.0
OPER = 0
TQUOTE = .FALSE.
NUMBER = .FALSE.
BNUM = .FALSE.
C
C---- Onto next character
C
END IF
END IF
END IF
10 CONTINUE
C
C
C---- End of character loop
C
20 CONTINUE
C
C---- End of line acts as a terminator
C
IF (TOKEN .AND. NUMBER) THEN
C
C---- End of a numeric token
C
ITYP(NTOK) = 2
FVALUE(NTOK) = VALUE*SIGN
IF (OPER.GT.0) FVALUE(NTOK) = MDOCAL(FVALUE(NTOK),OPER,
+ SIGN0*VALUE0)
IDEC(NTOK) = 100*IDOT + NPLACE
C
ELSE IF (TOKEN .AND. (TQUOTE.AND. (.NOT.QUOTE))) THEN
C
C---- End of a non-numeric token
C
ITYP(NTOK) = 3
IEND(NTOK) = LENLIM - 1
IDEC(NTOK) = IEND(NTOK) - IBEG(NTOK) + 1
ELSE IF (TOKEN .AND. (.NOT.TQUOTE)) THEN
ITYP(NTOK) = 1
IEND(NTOK) = LENLIM
IDEC(NTOK) = IEND(NTOK) - IBEG(NTOK) + 1
ELSE
NTOK = NTOK - 1
END IF
C
C
END
C== MPARSER ==
C
C
C
SUBROUTINE MPARSER(INFILE,IPRINT,LINEX,IBEGX,IENDX,ITYPX,
+ VALUEX,IDECX,NTOKX)
C =========================================================
C
C
C
C---- This routine reads in lines from unit INFILE, reflects them to
C unit number IPRINT and parses the lines by calling PARSE.
C The lines can be continued by using either a minus sign "-"
C or an ampersand "&" as a token and then continuing the record
C on the following line.
C
C
C---- See PARSE for a description of the subroutine arguments.
C
C
C
C
C
C
C
C .. Scalar Arguments ..
INTEGER INFILE,IPRINT,NTOKX
CHARACTER LINEX*400
C ..
C .. Array Arguments ..
REAL VALUEX(200)
INTEGER IBEGX(200),IDECX(200),IENDX(200),ITYPX(200)
C ..
C .. Local Scalars ..
INTEGER ICX,ILAST,ILINX,INCR,ITOK,MAXLIN,NTOK,NCH
LOGICAL CONTIN
CHARACTER LINE*400
C ..
C .. Local Arrays ..
REAL VALUE(40)
INTEGER IBEG(40),IDEC(40),IEND(40),ITYP(40)
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL MPARSE
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
C .. Data statements ..
DATA MAXLIN/5/
C ..
C
C
NTOKX = 0
ILINX = 1
INCR = 0
ICX = 0
10 CONTINUE
C
READ (INFILE,FMT=6000,END=30) LINE
C
NCH = LENSTR(LINE)
IF (NCH.GE.400) THEN
WRITE(IPRINT,FMT=6010)
WRITE(*,FMT=6010)
6010 FORMAT(1X,'**** ERROR ****',/,1X,'Line is too long (max 399',
+ ' characters) LINE IGNORED !!')
RETURN
END IF
IF (NCH.NE.0) WRITE (IPRINT,FMT=6002) LINE(1:NCH)
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
C
IF (NTOK.EQ.0) THEN
CAL IF (ONLINE) WRITE (ITOUT,FMT=6010)
CAL IF (BRIEF) WRITE (IBRIEF,FMT=6010)
CAL 6010 FORMAT (1X,'MOSFLM => ',$)
CAL GOTO 10
RETURN
ELSE
C
C---- Check if this LINE is to be continued via "-" or "&"
C as last token in line
C
IF (LINE(IBEG(NTOK) :IEND(NTOK)).EQ.'-' .OR.
+ LINE(IBEG(NTOK) :IEND(NTOK)).EQ.'&') THEN
CONTIN = .TRUE.
NTOK = NTOK - 1
ELSE
CONTIN = .FALSE.
END IF
C
C---- Copy line arrays to record arrays
C
DO 20 ITOK = 1,NTOK
NTOKX = NTOKX + 1
IBEGX(NTOKX) = IBEG(ITOK) + INCR
IENDX(NTOKX) = IEND(ITOK) + INCR
ITYPX(NTOKX) = ITYP(ITOK)
VALUEX(NTOKX) = VALUE(ITOK)
IDECX(NTOKX) = IDEC(ITOK)
20 CONTINUE
C
C---- Concatenate lines
C
IF (CONTIN) THEN
ILAST = IEND(NTOK+1) - 1
ELSE
ILAST = IEND(NTOK)
END IF
C
IF (ICX.EQ.0) THEN
LINEX = LINE(1:ILAST)
ELSE
LINEX = LINEX(:ICX)//LINE(1:ILAST)
END IF
ICX = ICX + ILAST
C
IF (CONTIN) THEN
C
ILINX = ILINX + 1
INCR = IEND(NTOK+1) + INCR - 1
IF (ILINX.LE.MAXLIN) THEN
GO TO 10
ELSE
GO TO 40
END IF
ELSE
RETURN
END IF
END IF
C
C---- End of input file
C
30 CONTINUE
NTOKX = -1
RETURN
C
C---- Too many lines
C
40 WRITE (IPRINT,FMT=6004)
STOP
C
C---- Format statements
C
6000 FORMAT (A)
6002 FORMAT (' ===> ',A)
6004 FORMAT (' --> *** TOO MANY CONTINUED LINES - MAXIMUM OF 5 ***')
C
C
END
C== MPAUSE ==
SUBROUTINE MPAUSE
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
WRITE(IBRIEF,FMT=100)
100 FORMAT(1X,'Enter carriage return')
READ(5,FMT=110,END=10)
110 FORMAT(1X)
10 CONTINUE
END
C =======================================================
SUBROUTINE MRDSYMM(JTOK,LINE,IBEG,IEND,ITYP,FVALUE,NTOK,
. SPGNAM,NUMSGP,PGNAME,NSYM,NSYMP,RSYM,IERR)
C =======================================================
C---- Read and decode symmetry specification
C
C---- Arguments:
C
C JTOK (I) INTEGER Number of first field to interpret
C
C LINE (I) CHARACTER*(*) Input string (from PARSER)
C
C IBEG (I) INTEGER(*) 1st column number of tokens in field
C (from PARSER)
C
C IEND (I) INTEGER(*) Last column number of tokens in field
C (from PARSER)
C
C ITYP (I) INTEGER(*) =0 null field
C =1 character string
C =2 number
C (from PARSER)
C
C FVALUE (I) REAL(*) Array of numbers. (from PARSER)
C
C NTOK (I) INTEGER The number of fields parsed. (from PARSER)
C
C
C NSYM (I/O) INTEGER Number of symmetry operations already read,
C including non-primitive.
C (should be cleared to 0 at beginning)
C
C SPGNAM (O) CHARACTER*(*) Space group name
C
C NUMSGP (O) INTEGER Space group number
C
C PGNAME (O) CHARACTER*(*) Point group name
C
C NSYMP (O) INTEGER Number of primitive symmetry operations
C
C RSYM (O) REAL(4,4,*) Symmetry matrices. * should be at least =NSYM
C
C IERR Returned non-zero if error in recognising spacegroup
C
C_END_RDSYMM
C
INTEGER JTOK,NTOK
INTEGER IBEG(*),IEND(*),ITYP(*)
REAL FVALUE(*)
CHARACTER*(*)LINE,SPGNAM,PGNAME
INTEGER NUMSGP,NSYM,NSYMP,IERR
REAL RSYM(4,4,*)
C
C---- Look at next field on line: this can be
C (a) a space-group number
C (b) a space-group name, ie a string beginning P,I,R,F,A,B or C
C (c) a symmetry operation (anything else)
C
C---- for cases (a) & (b), this is a single field:
C case (c) is more than 1 field
C
IF (JTOK.GT.NTOK) THEN
CALL PUTLIN(' No symmetry data !!!','CURWIN')
ELSE
IF (JTOK.EQ.NTOK) THEN
SPGNAM = ' '
IF (NSYM.GT.0) THEN
CALL PUTLIN('Warning: symmetry already given','CURWIN')
ENDIF
C
C---- A single field, see if it is a number or a string
C
IF (ITYP(JTOK).EQ.2) THEN
C
C---- it's a number, treat as space-group number
C
NUMSGP = NINT(FVALUE(JTOK))
ELSE
C
C---- it's a string, treat as space-group name
C
SPGNAM = LINE(IBEG(JTOK) :IEND(JTOK))
NUMSGP = 0
END IF
C
C---- Read symmetry (all operations) from SYMOP
C open symop on channel 24 - closed at end of reading
C NSYMP returns number of primitive operations
C
CALL CCPUPC(SPGNAM)
CALL MMSYMLB(24,NUMSGP,SPGNAM,PGNAME,NSYMP,NSYM,RSYM,IERR)
ELSE
C
C
C---- Read symmetry operations
C
NSYM = NSYM + 1
NSYMP = NSYM
CALL CCPUPC(LINE)
CALL SYMFR2(LINE,IBEG(JTOK),NSYM,RSYM)
NUMSGP = 0
SPGNAM = ' '
PGNAME = ' '
C
END IF
END IF
END
SUBROUTINE MRESET(ISEG,RPTFIRST,GENOPEN,COORDOPN)
C =================================================
C Re-initialises variables after an abort or fatal error when processing
C interactively, so that another attempt can be made.
C
IMPLICIT NONE
C
C Common block PARAMETER
C .. Include files ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Parameters ..
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C
C ..
C .. Scalar Arguments ..
INTEGER ISEG
LOGICAL RPTFIRST,GENOPEN,COORDOPN
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER MTZPRT,ITOG,IPAUSE,IERR
CHARACTER LINE*80,VALUESTR*80
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL LWCLOS,QCLOSE,MXDCIO,MXDPVL
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
C---- Reset all parameters, so a new run can start
C
TOSPT = 0
NSPOT = 0
ISTART = 0
MULTISEG = .FALSE.
NSERTOT = 0
NSEG = 0
ISEG = 0
NPACK = 0
NPACKS = 0
ISTARTP = 1
RPTFIRST = .FALSE.
NTLINE = NSAVELINE
IF (MTZOPEN) THEN
MTZPRT = 1
C *********************
CALL LWCLOS(MTZOUT,MTZPRT)
C *********************
MTZOPEN = .FALSE.
END IF
CLOSE (UNIT=INMO)
IF (GENOPEN) THEN
CALL QCLOSE(IUNIT)
GENOPEN = .FALSE.
END IF
IF (COORDOPN) THEN
CLOSE(ICOORD)
COORDOPN = .FALSE.
END IF
IF (DISPMENU) THEN
ADDPART = .FALSE.
SUMPART = .FALSE.
POWDER = .TRUE.
NBLOCK = 10
C
C---- Turn off Timeout mode if set
C
IF (LPAUSE) THEN
LPAUSE = .FALSE.
LINE = 'Timeout mode'
VALUESTR = ' '
ITOG = 2
IPAUSE = 48
CALL MXDPVL(IVHPAR, .TRUE., ITOG,LINE,IPAUSE,VALUESTR,IERR)
END IF
C
C---- If third display window open, close it
C
IF (DISP_IO3) CALL MXDCIO(21,0,0,0,0)
END IF
END
subroutine gettransform(theta, invert)
implicit none
integer theta, invert
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
write(*, *) 'gettransform rolling:'
write(*, *) 'cosom0 = ', cosom0, 'sinom0 = ', sinom0
write(*, *) 'omegaf = ', omegaf
if(invertx) then
invert = 1
else
invert = 0
end if
if(cosom0 .eq. 1) then
theta = 0
else if(cosom0 .eq. -1) then
theta = 180
else
if(sinom0 .eq. 1) then
theta = 270
else
theta = 90
end if
end if
end
C== MSELECT ==
C
C
C
SUBROUTINE MSELECT
C =================
C
C
C---- Last modified 5/10/88
C
C---- Chooses 20 refinement spots from those picked up in CENTRS
C to use in conjunction with those chosen by SEEKRS from
C outside of the film.
C
C---- Tests the distance of every reflection against every other,
C rejecting those closer than SEP. Increases SEP until only 20
C reflections are chosen out pf the whole list.
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
REAL DR,DSEP,DX,DY,SEP
INTEGER I,J,K
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C
C
SAVE
C ..
C
C
IF (NRS.GT.20) THEN
SEP = 200
10 CONTINUE
SEP = SEP + 100
DSEP = SEP*SEP
C
I = 1
20 CONTINUE
J = I + 1
30 CONTINUE
DX = ABS(XRS(I)-XRS(J))
C
C
IF (DX.LE.SEP) THEN
DY = ABS(YRS(I)-YRS(J))
C
C
IF (DY.LE.SEP) THEN
DR = DX*DX + DY*DY
C
C
IF (DR.LE.DSEP) THEN
NRS = NRS - 1
C
C
IF (J.LE.NRS) THEN
C
C
DO 40 K = J,NRS
XRS(K) = XRS(K+1)
YRS(K) = YRS(K+1)
RRS(K) = RRS(K+1)
40 CONTINUE
C
C
END IF
IF (NRS.EQ.20) RETURN
END IF
END IF
C
C
IF (J.LT.NRS) THEN
J = J + 1
GO TO 30
END IF
END IF
C
C
IF (I.GE.NRS-1) THEN
GO TO 10
ELSE
I = I + 1
GO TO 20
END IF
END IF
C
C
END
C== MSLEEP ==
SUBROUTINE MSLEEP(ITIME)
INTEGER ITIME
CALL SLEEP(ITIME)
RETURN
END
C== MSYSABS ==
C
C
C
SUBROUTINE MSYSABS(H,ABSNT)
C ==========================
C
C
C
C
C
C .. Scalar Arguments ..
LOGICAL ABSNT
C ..
C .. Array Arguments ..
INTEGER H(3)
C ..
C .. Local Scalars ..
INTEGER I,J
C ..
C .. Intrinsic Functions ..
INTRINSIC MOD
C ..
C .. Common blocks ..
C&&*&& include ../inc/sys.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sys.h
C---- START of include file sys.h
C
C
C .. Scalars in Common Block /SYS/ ..
INTEGER ISYS
C ..
C .. Arrays in Common Block /SYS/ ..
INTEGER KSYS
C ..
C .. Common Block /SYS/ ..
COMMON /SYS/ISYS,KSYS(3)
C ..
C
C
C&&*&& end_include ../inc/sys.f
SAVE
C ..
C
C
IF (ISYS.EQ.4) THEN
C
C---- Face centred lattice
C
ABSNT = .TRUE.
C
C
DO 10 I = 1,2
IF (MOD(H(I)+H(I+1),2).NE.0) RETURN
10 CONTINUE
C
C
ABSNT = .FALSE.
ELSE
C
C---- This version for A,B,C,R,I & F lattice absences
C
ABSNT = .FALSE.
J = 0
C
C
DO 20 I = 1,3
J = H(I)*KSYS(I) + J
20 CONTINUE
C
C
IF (MOD(J,ISYS).NE.0) ABSNT = .TRUE.
END IF
C
C
END
C
C
C
SUBROUTINE MXDBSY(IFLAG, TITLE)
C ===============================
C
c Create or destroy "Busy" box, ie notice to inform the user that
c the program is busy
c
c On entry:
c iflag > 0 initialise (create) box, if 0 use Ycoord BUSY_Y2
C for box, if > 0 use BUSY_Y
c = -1 destroy box
c
c title Message (create only)
c
IMPLICIT NONE
C
INTEGER IFLAG
CHARACTER*(*) TITLE
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER NCOLS, NROWS, IERR, L, ROWPAD, IROW, ICOL
INTEGER LENSTR,IY
EXTERNAL LENSTR
LOGICAL DSPLYD
DATA DSPLYD/.FALSE./, ROWPAD/5/
SAVE DSPLYD
C
IF (IFLAG .GE. 0) THEN
C Create box
IF (DSPLYD) CALL XDLF_DELETE_VIEW_OBJECT(IVHBUSY, IERR)
C
L = LENSTR(TITLE)
NROWS = 3
NCOLS = L + 2*ROWPAD
IY = BUSY_Y2
IF (IFLAG.GT.0) IY = BUSY_Y
CALL XDLF_TEXT_TABLE(IVHBUSY, IVHBAS, BUSY_X, IY,0,
$ NCOLS, NROWS, 0,0, BUSY_FONT, IERR)
C
IROW = 2
ICOL = ROWPAD + 1
CALL XDLF_TEXT_TABLE_TEXT(IVHBUSY, XDLSTR(TITLE), L,
$ IROW, ICOL, 0, IERR)
DSPLYD = .TRUE.
C
ELSE
C
C Destroy box
IF (DSPLYD) CALL XDLF_DELETE_VIEW_OBJECT(IVHBUSY, IERR)
DSPLYD = .FALSE.
ENDIF
RETURN
END
C
C
C
SUBROUTINE MXDBSY2(IFLAG, TITLE1, TITLE2)
C ========================================
C
c Create or destroy "Busy" box, ie notice to inform the user that
c the program is busy
c
c On entry:
c iflag >= 0 initialise (create) box, if 0 use Ycoord BUSY_Y2
C for box, if > 0 use BUSY_Y
c = -1 destroy box
c
c title Message (create only)
c
IMPLICIT NONE
C
INTEGER IFLAG
CHARACTER*(*) TITLE1,TITLE2
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER NCOLS, NROWS, IERR, L1, l2, ROWPAD, IROW, ICOL
INTEGER LENSTR,IY
EXTERNAL LENSTR
LOGICAL DSPLYD
DATA DSPLYD/.FALSE./, ROWPAD/5/
SAVE DSPLYD
C
IF (IFLAG .GE. 0) THEN
C Create box
IF (DSPLYD) CALL XDLF_DELETE_VIEW_OBJECT(IVHBUSY2, IERR)
C
L1 = LENSTR(TITLE1)
L2 = LENSTR(TITLE2)
NROWS = 3
NCOLS = MAX(L1,L2) + 2*ROWPAD
IY = BUSY_Y2
IF (IFLAG.GT.0) IY = BUSY_Y
CALL XDLF_TEXT_TABLE(IVHBUSY2, IVHBAS, BUSY_X, IY,1,
$ NCOLS, NROWS, 0,0, BUSY_FONT, IERR)
C
IROW = 2
ICOL = ROWPAD + 1
CALL XDLF_TEXT_TABLE_TEXT(IVHBUSY2, XDLSTR(TITLE1), L1,
$ IROW, ICOL, 0, IERR)
IROW = 3
ICOL = ROWPAD + 1
CALL XDLF_TEXT_TABLE_TEXT(IVHBUSY2, XDLSTR(TITLE2), L2,
$ IROW, ICOL, 0, IERR)
DSPLYD = .TRUE.
C
ELSE
C
C Destroy box
IF (DSPLYD) CALL XDLF_DELETE_VIEW_OBJECT(IVHBUSY2, IERR)
DSPLYD = .FALSE.
ENDIF
RETURN
END
C
C
C
SUBROUTINE MXDCIO(IFLAG, IO_COL, IO_ROWS,IX,IY)
C ===============================================
C
C---- Create or delete IO area
C
C IFLAG = 0 create, = 1 delete
C IFLAG >1 and < 10, create and set NSCROLL to IFLAG-1
C If IFLAG is > 10, work on second i/o window (IVHIO2)
C If IFLAG is > 20, work on third i/o window (IVHIO3)
C
IMPLICIT NONE
INTEGER IFLAG, IO_COL, IO_ROWS, IX, IY,IVH,IFLAG2,NSCROL
LOGICAL DISP_IOL
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
INTEGER IERR
SAVE
C
C---- NSCROLL is a parameter in mdxinc.h
C
NSCROL = NSCROLL
IVH = IVHIO
IFLAG2 = IFLAG
DISP_IOL = DISP_IO
IF (IFLAG2.GE.20) THEN
IVH = IVHIO3
IFLAG2 = IFLAG2 - 20
DISP_IOL = DISP_IO3
ELSE IF (IFLAG2.GE.10) THEN
IVH = IVHIO2
IFLAG2 = IFLAG2 - 10
DISP_IOL = DISP_IO2
END IF
IF ((IFLAG.GT.1).AND.(IFLAG.LT.10)) THEN
IFLAG2 = 0
NSCROL = IFLAG - 1
END IF
C
IF (IFLAG2 .EQ. 0) THEN
IF (.NOT.DISP_IOL) THEN
CALL XDLF_IO_WINDOW(IVH, 0, IX, IY, 1,
$ IO_COL, IO_ROWS, 0, 0, IO_FONT, NSCROL, IERR)
IF (IERR .NE. 0) CALL MXDERR('MXDCIO: Error',1,IERR)
IF (IFLAG.GE.20) THEN
DISP_IO3 = .TRUE.
ELSE IF (IFLAG.GE.10) THEN
DISP_IO2 = .TRUE.
ELSE
DISP_IO = .TRUE.
ENDIF
ENDIF
ELSE IF (IFLAG2 .GT. 0) THEN
IF (DISP_IOL) CALL XDLF_DELETE_VIEW_OBJECT(IVH, IERR)
IF (IFLAG.GE.20) THEN
DISP_IO3 = .FALSE.
ELSE IF (IFLAG.GE.10) THEN
DISP_IO2 = .FALSE.
ELSE
DISP_IO = .FALSE.
ENDIF
ENDIF
C
RETURN
END
C
C
SUBROUTINE MXDCIR(NCIRC,RESCMX, DISTANCE, THETA, WAVELENGTH,
$ RESCIR)
C ==================================================================
c
c Draw resolution circles
c
c Input:
c ncirc number of circles
c rescmx maximum resolution of circles
c distance detector distance (mm)
c THETA detector angle (degrees)
c wavelength wavelength (A)
c
c Output:
c rescir(ncirc) resolution of each circle (A)
c
IMPLICIT NONE
C
INTEGER NCIRC
REAL RESCMX, DISTANCE, THETA, WAVELENGTH, RESOL, RESCIR(NCIRC)
C
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
REAL VDCO(3), S0(3), DD(3,3), DDINV(3,3), DN(3)
REAL DET, R(3), W(3), S(3), S1(3), COSTHE, SINTHE, VDCC(3)
REAL S1NEW(3), ANG(3), RMAT(3,3)
REAL PI, DST, DSTINT, RAD, DELROT, YY, ZZ
INTEGER I,J,IERR,ISTAT,NSTEP,JY,JZ,IXF0,IYF0,IXF,IYF,MAGUPD
C
c delarc approximate arc length in mm (in image frame)
REAL DELARC
DATA DELARC /4.0/
C
c CALL SETDD(DISTANCE, THETA, S0, DD, DDINV, DN)
CALL SETDD(DISTANCE, 0.0, S0, DD, DDINV, DN)
C
PI = 4.0 * ATAN(1.0)
C d* for highest resolution circle
DST = WAVELENGTH/RESCMX
C interval
DSTINT = DST/NCIRC
C
ANG(1) = 0.0
ANG(2) = 0.0
C loop circles, outer first ------------------
DO 10, J = 1, NCIRC
RESCIR(J) = WAVELENGTH/DST
SINTHE = DST*0.5
COSTHE = SQRT(1.0 - SINTHE**2)
C initial diffraction vector at (cos theta 0 -sin theta)
S(1) = DST*COSTHE
S(2) = 0.0
S(3) = DST*SINTHE
c initial diffracted beam vector (for circle) s1 = s - s0
CALL VSUB(S1,S,S0)
c initial position on the detector
CALL DETCAL(S1,DISTANCE,DDINV,DN,VDCC)
c at each step, we are going to rotate by delrot around the z axis = s0
RAD = SQRT(VDCC(1)**2 + VDCC(2)**2)
30 NSTEP = NINT(2.0 * PI * RAD / DELARC)
IF(NSTEP.LT.25)THEN
DELARC = DELARC/2.0
GOTO 30
ENDIF
IF (NZOOM .GT. 0) NSTEP = NSTEP * NZOOM
DELROT = 360.0 / FLOAT(NSTEP)
C
IXF0 = -1
MAGUPD = 0
c loop vectors in circle
DO 20, I = 0, NSTEP+1
c we are rotating around z = s0, ang in degrees
ANG(3) = I * DELROT
CALL ROTMAT(ANG, RMAT,1)
CALL MATVEC(S1NEW,RMAT, S1)
C Position on the detector
CALL DETCAL(S1NEW,DISTANCE,DDINV,DN,VDCC)
C Convert to pixels
CALL MMTOPX1(VDCC(1), VDCC(2), YY, ZZ, ISTAT)
IF (ISTAT .EQ. 0) THEN
C This pixel is on detector, convert to display position
IXF = NINT(ZZ)
IYF = NINT(YY)
IF (ISTAT .EQ. 0) THEN
C point on current display as well
IF (IXF0 .GT. 0) THEN
C and last point valid
IF (I .EQ. NSTEP+1) MAGUPD = 1
CALL XDLF_IMAGE_VECT(IVHIMG,CIR_IVEC,
$ IXF0,IYF0,IXF,IYF,CIR_COLR,CIR_IOVL,MAGUPD,IERR)
IF (IERR .NE. 0) GO TO 999
ENDIF
C store point for next line
IXF0 = IXF
IYF0 = IYF
ELSE
IXF0 = -1
ENDIF
ELSE
IXF0 = -1
ENDIF
20 CONTINUE
C
C next circle
DST = DST - DSTINT
10 CONTINUE
C
C symbol in centre
VDCC(1) = 0.0
VDCC(2) = 0.0
CALL MMTOPX1(VDCC(1), VDCC(2), YY, ZZ, ISTAT)
IF (ISTAT .EQ. 0) THEN
C this pixel is on detector
C convert to display position
IXF = NINT(ZZ)
IYF = NINT(YY)
C point on current display as well
CALL XDLF_IMAGE_SYMBOL(IVHIMG,IXF,IYF,
$ CIR_SYMB,CIR_COLR,CIR_IOVL,IERR)
IF (IERR .NE. 0) GO TO 999
ENDIF
C
RETURN
C
999 CALL MXDERR('MXDCIR: Error',1,IERR)
END
subroutine mxdcpm(ncirpt, mcirpt, circen, cirrad, rmsres)
c =================================================================
c
c Display circle fit parameters
c
c Use io window as for pick, delete any existing one first
c
c On entry:
c ncirpt number of points in list
c mcirpt number of points fitted
c circen(2) coordinates of centre (mm in scanner coordinates)
c cirrad radius (mm)
c cyscal relative pixel size in yc direction compared to
c xc (xc == Zms, yc == Yms)
c rmsres rms residual
c
implicit none
c
integer ncirpt, mcirpt
real circen(2), cirrad, rmsres
c
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM = 200)
C
C YPXSIZ pixel size in mm along Yms (== Yc)
C ZPXSIZ pixel size in mm along Zms (== Xc)
c
c
c
CHARACTER*80 LINE,LLINE, LINE2
CHARACTER STR1*1
c CHARACTER*101 IOLINE(100)
INTEGER L, IX, IY, IBUTTON, ISTAT, L2
LOGICAL ACCEPT,NULINE
REAL PXCEN,PYCEN
c
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Subroutines ..
integer lenstr
external lenstr
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C
c Minimum & maximum values of Yscale for warning
c real YSCMIN, YSCMAX
c parameter (YSCMIN = 0.3, YSCMAX = 3.0)
c Maximum rms deviation
real RMSMAX
parameter (RMSMAX = 5.0)
c
IF (MCIRPT .EQ. 1) THEN
c
c Delete points
CALL MXDDSY
C Draw circle
CALL MXDDRC(CIRCEN, CIRRAD)
C
WRITE(IOLINE,FMT=100)
CALL WINDIO(NULINE)
100 FORMAT('You have chosen only one point; you can use this',/,
$ ' to define the new beam centre, but not the ',/,
$ 'backstop position.')
PXCEN = CIRCEN(1)
IF (INVERTX) PXCEN = NREC*RAST - PXCEN
PYCEN = CIRCEN(2)
WRITE (LINE, '(A,2F8.3)') ' Co-ordinates: '
$ ,PXCEN,PYCEN
CALL MXDWIO(LINE, 3)
line = ' Update main beam position? (Y) '
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LLINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LLINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LLINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
CAL **** CORRECT BEAM COORDINATES HERE
CAL
XCEN = 100.0*CIRCEN(1)
YCEN = 100.0*YSCAL*CIRCEN(2)
ACCEPT = .TRUE.
IBEAM = 1
END IF
else if (mcirpt .ge. 4) then
c
write (line, '(a,i6,a)')
$ ' Best fit circle to',mcirpt,' points'
call mxdwio(line, 2)
write (line, '(a,f8.3,a)')
$ ' RMS residual = ',rmsres,' mm'
call mxdwio(line, 2)
if (rmsres .gt. RMSMAX) then
write (line, '(a)')
$ ' **** WARNING: large residual ****'
call mxdwio(line, 2)
endif
pxcen = circen(1)
if (invertx) pxcen = nrec*rast - pxcen
pycen = circen(2)
write (line, '(a,2f8.3)') ' Centre of circle : '
$ ,pxcen,pycen
call mxdwio(line, 2)
write (line, '(a,f8.3)') ' Radius of circle (mm) : '
$ ,cirrad
call mxdwio(line, 2)
line = ' '
call mxdwio(line, 2)
write (line, '(a)')
$ ' If you accept the fit, the beam centre will '
call mxdwio(line, 2)
write (line, '(a)')
$ ' be changed'
call mxdwio(line, 2)
call xdlf_flush_events(l)
c
c Delete points
if (mcirpt .gt. 0) call mxddsy
c Draw circle
if (mcirpt .ge. 4) call mxddrc(circen, cirrad)
c
if (rmsres .gt. RMSMAX) then
ACCEPT = .FALSE.
line = ' Update main beam position? (N) '
else
ACCEPT = .TRUE.
line = ' Update main beam position? (Y) '
end if
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LLINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LLINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
IF (ACCEPT) THEN
STR1 = 'Y'
ELSE
STR1 = 'N'
END IF
ELSE
STR1 = LLINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
CAL **** CORRECT BEAM COORDINATES HERE
CAL
XCEN = 100.0*CIRCEN(1)
YCEN = 100.0*YSCAL*CIRCEN(2)
ACCEPT = .TRUE.
IBEAM = 1
END IF
C
C---- or update backstop shadow position and radius
C
if (rmsres .gt. RMSMAX) then
ACCEPT = .FALSE.
line = ' Update backstop radius & position? (N) '
else
ACCEPT = .TRUE.
line = ' Update backstop radius & position? (Y) '
end if
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LLINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LLINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
IF (ACCEPT) THEN
STR1 = 'Y'
ELSE
STR1 = 'N'
END IF
ELSE
STR1 = LLINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
CHRP **** CORRECT BACKSTOP COORDINATES HERE
CHRP
RMINX = CIRCEN(1)*100.0
RMINY = YSCAL*CIRCEN(2)*100.0
RMIN = CIRRAD*100.0
ACCEPT = .TRUE.
IIBACK = .TRUE.
END IF
ENDIF
c
call mxdcio(1,0,0,0,0)
call xdlf_flush_events(l)
c
return
end
C
C
SUBROUTINE MXDCRS(IX, IY, ICOLR)
C ================================
C
c Draw cross at point IX, IY, colour icolr.
c
IMPLICIT NONE
C
INTEGER IX, IY, ICOLR
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
c
INTEGER ISTAT, IERR
C
C---- check within display
C
CALL CNVPIX(IX,IY,ISTAT)
IF (ISTAT .EQ. 0) THEN
c Point on current display as well
CALL XDLF_IMAGE_SYMBOL(IVHIMG,IX,IY,
$ CROSS_SYMB,ICOLR,CROSS_IOVL,IERR)
ENDIF
C
RETURN
END
C
C
SUBROUTINE MXDDLG(PROMPT, IX, IY, LINE, ISTAT)
C ==============================================
C
c Popup dialog box, used to prompt for an input text string (eg filename)
c
c Input:
c prompt prompt string
c ix,iy position
c
c Output:
c line input string
c istat return code
c = 0 blank
c = 1 string returned
c = -1 aborted
c = -2 unable to allocate memory
c = -3 no room for string
c
IMPLICIT NONE
C
CHARACTER*(*) PROMPT, LINE
INTEGER IX,IY,ISTAT
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
c
INTEGER LENSTR
EXTERNAL LENSTR
INTEGER L, M
C
L = LENSTR(PROMPT)
M = LEN(LINE)
CALL XDLF_POPUP_DIALOG(IX,IY,XDLSTR(PROMPT),L,LEN_DIALOG,
$ XDLSTR(LINE),M,MEN_FONT,1,1,ISTAT)
RETURN
END
subroutine mxddrc(circen, cirrad)
c =================================
c
c Draw circle
c
c Input:
c circen(2) centre of circle, (Xc, Yc in mm)
c cirrad radius in mm
c
implicit none
c
real circen(2), cirrad
c
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
c
real ang, s(2)
real pi, delrot, xc, yc, yy, zz, xx
integer i,j,istat,nstep,jy,jz,ixf0,iyf0,ixf,iyf,magupd, ierr
c
c delarc approximate arc length in mm (in image frame)
real delarc
data delarc /4.0/
c
c
pi = 4.0 * atan(1.0)
c
s(1) = cirrad
s(2) = 0.0
c
c at each step, we are going to rotate by delrot around the z axis
10 nstep = nint(2.0 * pi * cirrad / delarc)
IF(NSTEP.LE.12)THEN
DELARC=DELARC/2.0
GOTO 10
ENDIF
if (nzoom .gt. 0) nstep = nstep * nzoom
delrot = 2.0 * pi / float(nstep)
c
ixf0 = -1
magupd = 0
c loop vectors in circle
do 20, i = 0, nstep+1
ang = i * delrot
xc = s(1) * cos(ang) - s(2) * sin(ang) + circen(1)
yc = s(1) * sin(ang) + s(2) * cos(ang) + circen(2)
c Convert to pixels
call xyc2px(xx, yy, xc, yc, istat)
if (istat .eq. 0) then
c This pixel is on detector
c Convert to display position
ixf = nint(xx)
iyf = nint(yy)
c Point on current display as well
if (ixf0 .gt. 0) then
c and last point valid
if (i .eq. nstep+1) magupd = 1
CALL XDLF_IMAGE_VECT(IVHIMG,CIR_IVEC,
$ IXF0,IYF0,IXF,IYF,CIR_COLR,CIR_IOVL,MAGUPD,IERR)
if (ierr .ne. 0) go to 999
endif
c store point for next line
ixf0 = ixf
iyf0 = iyf
else
ixf0 = -1
endif
20 continue
c
c
c Symbol in centre
call xyc2px(xx, yy, circen(1), circen(2), istat)
if (istat .eq. 0) then
c This pixel is on detector
c Convert to display position
ixf = nint(xx)
iyf = nint(yy)
c Point on current display as well
CALL XDLF_IMAGE_SYMBOL(IVHIMG,IXF,IYF,
$ CIR_SYMB,CIR_COLR,CIR_IOVL,IERR)
if (ierr .ne. 0) go to 999
endif
c
return
c
999 call mxderr('MXDDRC: error',1,ierr)
end
C
C
SUBROUTINE MXDDSY
C =================
C
c Delete all overlay symbols
c
IMPLICIT NONE
c
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER IERR
C
CALL XDLF_IMAGE_CLEAR_SYMBOLS(IVHIMG, IERR)
RETURN
END
C
C
SUBROUTINE MXDDVC
C =================
C
c Delete all overlay vectors (NOT symbols...see mxddsy)
c
IMPLICIT NONE
c
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
INTEGER IERR
C
CALL XDLF_IMAGE_CLEAR_VECTS(IVHIMG, IERR)
RETURN
END
C
SUBROUTINE MXDDVN(N)
C =================
C
C---- Delete overlay vectors number "N"
C
C (NOT symbols...see mxddsy)
C
IMPLICIT NONE
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Local Scalars ..
INTEGER IERR
C
CALL XDLF_IMAGE_DEL_VECT(IVHIMG, N, IERR)
RETURN
END
C
C
C
SUBROUTINE MXDERR(MESSGE,NUM,ISTAT)
C
c print error message & stop
c
CHARACTER*(*) MESSGE
INTEGER NUM,ISTAT
C
WRITE (6,'(A,A,A,I6,A,I6)') ' *** Error in routine: ',messge,
$ ': number:',num,' status: ',ISTAT
STOP
END
SUBROUTINE MXDIMG(RESET,
$ IMAGE,NXPIX,NYPIX,MAXVAL,MINTHR,MAXTHR,TITLE)
C =====================================================
C
C Display image
c Input
c title title
c reset .true. is image is to be recreated, eg new scale
c image full image, nxpix in slow direction, nypix in fast
c
c
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C .. Scalar Arguments ..
CHARACTER*(*) TITLE
LOGICAL RESET
INTEGER NXPIX,NYPIX,MAXVAL,MINTHR,MAXTHR
C ..
C .. Array Arguments ..
INTEGER*2 IMAGE(NXPIX*NYPIX)
C ..
C .. Local Scalars ..
INTEGER IERR, L, NF_OFF,MINVAL,
+ ICONTRAST,IDISP_NOW,I,J,K
C ..
C .. External Functions ..
c
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C
NF_OFF = 0
MINVAL = 0
ICONTRAST = 1000
IDISP_NOW = 1
C
C
C---- Set RESET true all the time for now
C
RESET = .TRUE.
IF (RESET) THEN
c Delete old image if present
IF (DISP_IMG) CALL XDLF_DELETE_VIEW_OBJECT(IVHIMG,IERR)
DISP_IMG = .FALSE.
ENDIF
C
C ----------- First time -------------
IF (.NOT. DISP_IMG) THEN
C
C display image
CAL CALL XDLF_FILM_IMAGE(
CAL $ IVHIMG,IVHBAS,IMG_X,IMG_Y,ICSET,IFTYPE,IMAGE_ORDER,
CAL $ DIMAGE,MU,MV,MAXVAL,MINTHR,MAXTHR,
CAL $ MINW,MAXW, IXOPIX,IYOPIX, IXCMP, IYCMP, IBG, IOVLY,
CAL $ IFULL, IMAGE, IFILED, NXDPX, NYDPX, IERR)
C
CALL XDLF_IMAGE(
+ IVHIMG,IVHBAS,IMG_X,IMG_Y,ICSET,IMAGE,IFTYPE,
+ NXDPX,NYDPX,NYDPX,IXOPIX,IYOPIX,NXDPX,NYDPX,NXP_CMP,
CAL corrrect ? + NXDPX,NYDPX,NYDPX,IXOPIX,IYOPIX,MMU,MMV,NXP_CMP,
+ IMAGE_ORDER,JIMAGE_ORDER,MINVAL,MAXVAL,MINTHR,MAXTHR,
+ MINW,MINH,IBG,IOVLY,ICONTRAST,IDISP_NOW,IERR)
C
IF (IERR .NE. 0) CALL MXDERR('MXDIMG',1,IERR)
DISP_IMG = .TRUE.
C
C ------------ Image already present, update -----------
ELSE
c Remove overlays
CALL MXDDVC
CALL MXDDSY
C
CAL CALL XDLF_FILM_IMAGE_NEWIMG(IVHIMG, DIMAGE, IFULL, IMAGE,
CAL $ IFILED, IERR)
C
C CALL XDLF_IMAGE_NEWIMG(IVHIMG, DIMAGE, IDISP_NOW,IERR)
CALL XDLF_IMAGE_NEWIMG(IVHIMG, IMAGE, IDISP_NOW,IERR)
IF (IERR .NE. 0) CALL MXDERR('MXDIMG',2,IERR)
ENDIF
C
L = LENSTR(TITLE)
CALL XDLF_IMAGE_INPUT_MESSAGE(IVHIMG,XDLSTR(TITLE),L,IERR)
RETURN
END
C
c
c
SUBROUTINE MXDINI(NXPIX,NYPIX)
C ===============================
C
c Initialize windows
c
c Input
c NXPIX, NYPIX full image size in pixels, slow and fast directions
c
IMPLICIT NONE
INTEGER NXPIX, NYPIX
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/dsdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsdinc.h
C---- START of include file dsdinc.h
C
C/DSDINC/
C
C Detector image file parameters
c
C imgdrc The string defines the axis order for display in terms
C of x (across) and y (up). The slower moving axis is
C given first followed by the faster moving axis. Minus
C signs are used when the order of an axis is reversed.
C
C examples: FAST +x+y slow axis (Zms) across, fast axis (Yms) up
C Mar -x+y Zms across backwards, fast axis (Yms) up
C
character*8 drcdef
parameter (drcdef='-x+y')
character*8 imgdrc
common /imgstc/ imgdrc
save /imgstc/
C/DSDINC/
C&&*&& end_include ../inc/dsdinc.f
c
c Parameters
c base_x, base_y position of base window (=-1 chosen by window manager)
INTEGER BASE_X, BASE_Y
PARAMETER (BASE_X=-1, BASE_Y=-1)
C
INTEGER NUMC
PARAMETER (NUMC=1)
C
INTEGER BLANK_X, BLANK_Y, BLANK_WIDTH, BLANK_HEIGHT
C
INTEGER NCOLORS(NUMC),NPLANES(NUMC),IERR, L, ISWAP, J
INTEGER NQYP, NQZP
INTEGER LENSTR
EXTERNAL LENSTR
CHARACTER TITLE*60,ICON_LABEL*10
LOGICAL FIRST
SAVE FIRST
C
DATA TITLE/'MOSFLM Image Display'/, ICON_LABEL/'MOSFLM'/
DATA FIRST/.TRUE./
C
BLANK = .FALSE.
DISP_MENU = .FALSE.
DISP_IO = .FALSE.
DISP_PAR = .FALSE.
DISP_NOT = .FALSE.
DISP_IMG = .FALSE.
c set up axis order for display
C imgdrc The string defines the axis order for display.
C The slower moving axis is given first followed by the
C faster moving axis. Minus signs are used when the order
C of an axis is reversed.
C
IMGDRC = '+x+y'
L = LENSTR(IMGDRC)
CALL XDLF_AXORD(XDLSTR(IMGDRC),L,IMAGE_ORDER,ISWAP,IERR)
C
C---- IMAGE_ORDER returned as 1 for string +x+y
C
IF (IMAGE_ORDER .LE. 0 .OR. ISWAP .GE. 2 .OR. IERR .NE. 0) THEN
c illegal axis order: don't allow byte-swap for now
CALL MXDERR('MXDINI: error in axis order',iswap,ierr)
ENDIF
C
C---- Set display order
C
JIMAGE_ORDER = 2
c
c Determine compression, if any
c max_pixel is maximum number of pixels in display
NQYP = NXPIX/MAX_PIXEL + 1
NQZP = NYPIX/MAX_PIXEL + 1
C . . but we must compress by the same factor in both directions
NQYP = MAX(NQYP, NQZP)
NQZP = NQYP
c
c number of pixels in whole image
NXDPX = NXPIX
NYDPX = NYPIX
c compression
NXP_CMP = NQZP
NYP_CMP = NQYP
C
C
IF (FIRST) THEN
FIRST = .FALSE.
c initialize
c (number of coloursets, number of colours, number of overlay planes)
NCOLORS(1) = 72
NPLANES(1) = 0
CALL XDLF_OPEN_VIEW(NUMC,NCOLORS,NPLANES,IERR)
IF (IERR .NE. 0) THEN
c Accept error = 1 (monochrome)
IF (IERR .NE. 1) THEN
CALL MXDERR('MXDINI',1,IERR)
ENDIF
ENDIF
ENDIF
C
c Calculate sizes
c Parameters
PAR_X = BORDER
PAR_Y = BORDER
CALL XDLF_PARAM_TABLE_GETSIZE(MAX_PAR_COL, MAX_PAR_ROWS,
$ MAX_PAR_NAME, MAX_PAR_STR, PAR_TITLE, PAR_FONT, PAR_MENU,
$ PAR_WIDTH, PAR_HEIGHT)
C
c Menu
MEN_X = PAR_X + PAR_WIDTH + BORDER
MEN_Y = MEN_Y
CALL XDLF_MENU_AREA_GETSIZE(MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT,
$ MEN_QUIT_FLAG, MAX_MEN_TITLE, MEN_WIDTH, MEN_HEIGHT)
c
c Notice area, under menu
NOT_X = MEN_X
NOT_Y = PAR_Y + MEN_HEIGHT + BORDER
CALL XDLF_PARAM_TABLE_GETSIZE(MAX_NOT_COL, MAX_NOT_ROWS,
$ MAX_NOT_NAME, MAX_NOT_STR, NOT_TITLE, NOT_FONT, NOT_MENU,
$ NOT_WIDTH, NOT_HEIGHT)
c
c Abort menu
PMN_X = PAR_X
PMN_Y = PAR_Y + MAX(MEN_HEIGHT, PAR_HEIGHT+NOT_HEIGHT+BORDER)
CALL XDLF_MENU_AREA_GETSIZE(MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT,
$ PMN_QUIT_FLAG, MAX_PMN_TITLE, PMN_WIDTH, PMN_HEIGHT)
c
c Progress bar
PPB_X = PAR_X
PPB_Y = PMN_Y + PMN_HEIGHT + BORDER
PPB_WIDTH = MEN_WIDTH + PAR_WIDTH
c
c Image
IMG_X = PAR_X + PAR_WIDTH + MEN_WIDTH + BORDER
IMG_Y = PAR_Y
CAL CALL XDLF_FILM_IMAGE_GETSIZE(NXPX, NYPX,
CAL $ IMG_WIDTH, IMG_HEIGHT)
C
CAL2 CALL XDLF_IMAGE_GETSIZE(NXPX,NYPX,IMAGE_ORDER,IMAGE_ORDER,
CALL XDLF_IMAGE_GETSIZE(NXPIX,NYPIX,IMAGE_ORDER,JIMAGE_ORDER,
+ NXP_CMP,IMG_WIDTH, IMG_HEIGHT)
c
BASE_WIDTH = IMG_WIDTH + MEN_WIDTH + PAR_WIDTH
$ + 4*BORDER
BASE_HEIGHT = MAX(IMG_HEIGHT + 2*BORDER,
$ MEN_HEIGHT + NOT_HEIGHT+3*BORDER, PAR_HEIGHT+2*BORDER)
CALL XDLF_BASE_FRAME(IVHBAS,BASE_WIDTH,BASE_HEIGHT,XDLSTR(TITLE),
$ LENSTR(TITLE), XDLSTR(ICON_LABEL),LENSTR(ICON_LABEL),
$ BASE_X,BASE_Y)
C
C
c Busy box
BUSY_X = MEN_WIDTH + PAR_WIDTH + 2*BORDER
BUSY_Y = BASE_HEIGHT/2
BUSY_Y2 = BASE_HEIGHT - 70
C
c Blank to fill space
IF (IMG_HEIGHT .GT.
$ MAX(MEN_HEIGHT+NOT_HEIGHT+BORDER, PAR_HEIGHT)) THEN
BLANK = .TRUE.
BLANK_X = PMN_X
BLANK_Y = PMN_Y
BLANK_WIDTH = MEN_WIDTH + PAR_WIDTH + BORDER
BLANK_HEIGHT = IMG_HEIGHT -
$ MAX(MEN_HEIGHT+NOT_HEIGHT+BORDER, PAR_HEIGHT)
CALL XDLF_BLANK_OBJECT(IVHBLANK, IVHBAS, BLANK_X, BLANK_Y,
$ 1, BLANK_WIDTH, BLANK_HEIGHT, IERR)
ENDIF
C
RETURN
END
subroutine mxdmkn
c =================
c
c Create output window for display of circle parameters
c
c
implicit none
c
c
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
c
integer NROWS, NCOLS
parameter (NROWS = 14, NCOLS = 50)
c
character*(NCOLS) line
integer l, ix, iy, ibutton, istat
c
ix = -1
iy = -1
c
CAL if (l_iow) call mxdcio(1,0,0,0,0)
call mxdcio(0,NCOLS,NROWS, ix, iy)
c
c
write (line, '(a)')
$ ' Click on points around circle to position '
call mxdwio(line, 2)
write (line, '(a)')
$ ' the main beam and/or the backstop OR on a '
call mxdwio(line, 2)
write (line, '(a)')
$ ' single point (for the main beam only), '
call mxdwio(line, 2)
write (line, '(a)')
$ ' then on "Fit points" menu option again.'
call mxdwio(line, 2)
write (line, '(a)')
$ ' '
call mxdwio(line, 2)
write (line, '(a)')
$ ' Click on existing point to delete it'
call mxdwio(line, 2)
line = ' '
call mxdwio(line, 2)
call xdlf_flush_events(l)
c
return
end
c
c
c
c
c
SUBROUTINE MXDMNU(MENU_ITEMS, EXIT_NAME)
c ========================================
c
c Initialize display menu
c
c On entry:
c menu_items names of menu items
c exit_name name of exit box
c
IMPLICIT NONE
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
CHARACTER*(MAX_MEN_NAME) MENU_ITEMS(MAX_MEN_ITMS)
CHARACTER*(*) EXIT_NAME
C
INTEGER IERR, MIN_W, MIN_H
INTEGER LENSTR
EXTERNAL LENSTR
C
C
SAVE
C
IF (.NOT. DISP_MENU) THEN
MIN_W = 0
MIN_H = 0
CALL XDLF_MENU_AREA(IVHMEN, IVHBAS, MEN_X, MEN_Y, 1,
$ MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE, MIN_W, MIN_H, IERR)
IF (IERR .NE. 0) GO TO 999
DISP_MENU = .TRUE.
ENDIF
C
CALL XDLF_MENU_AREA_SETMENU(IVHMEN, MAX_MEN_ITMS,
$ XDLSTR(MENU_ITEMS),MAX_MEN_NAME, XDLSTR('Main menu'),
$ 9,XDLSTR(EXIT_NAME),LENSTR(EXIT_NAME),MEN_FONT,IERR)
IF (IERR .NE. 0) GO TO 999
C
RETURN
C
999 CALL MXDERR('MXDMNU: error',1,IERR)
END
C== MXDNOT ==
SUBROUTINE MXDNOT(IX1, IY1, RESOL, SPACNG, AVG, RMS, N, NZOOM,
$ RESCIR, NCIRC,IHKL,IRECG,PLRESID)
C ====================================================
C
C---- The width of the notice window is currently 23 characters
C
c Initialize notice area. The notice area is a parameter area, with no active
c values, ie all in label mode, for display of information
c
c Pixel IX1, IY1 coords of last picked pixel (image pixels)
C XC,YC mm
c Resolution resolution
C Indices
C Reflection class and partiality
C Intensity (if available)
C Sd (if available)
C ....blank...
c Spacing cell spacing from Measure
c Average average of box
c Rms rms of box
c Number number of points in box
c Zoomfactor zoom factor
c Circle resolution rescir(ncirc) resolution for circles
C values
C Phi range
C Missets
C values
C
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
INTEGER IY1,IX1,N,NZOOM,NCIRC,IRECG
REAL RESOL, SPACNG, AVG, RMS, RESCIR(NCIRC)
INTEGER IHKL(5)
LOGICAL PLRESID
C
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
c
CHARACTER LINE*80
INTEGER L, LABEL, IERR,I
INTEGER LENSTR
EXTERNAL LENSTR
LOGICAL FIRST, REPLACE
REAL XC, YC
C
INTEGER NOT_PIXR, NOT_XYC, NOT_RESO, NOT_SPCN, NOT_STAT, NOT_RMS,
$ NOT_NPX, NOT_RLAB, NOT_RCIR, NOT_HKL, NOT_ZOOM,
$ NOT_PHI,NOT_THETA,NOT_DELPHI,NOT_CLASS,NOT_INT,NOT_SD,
$ NOT_BLNK
INTEGER IXTRUE,IPOINT,IWIDTH,INTPR,ISIGPR,IFLAG
REAL XTRUE,WIDSP,PHISP
CHARACTER*8 NOTICE_TITLE
CHARACTER*20 STRCLASS(6)
C
SAVE FIRST
C
DATA LABEL/-1/
DATA NOT_PIXR, NOT_XYC, NOT_RESO, NOT_HKL,
$ NOT_CLASS, NOT_INT,NOT_SD,NOT_BLNK,NOT_SPCN,
+ NOT_STAT, NOT_RMS,
$ NOT_NPX, NOT_ZOOM, NOT_RLAB, NOT_RCIR,
$ NOT_PHI,NOT_THETA,NOT_DELPHI
$ /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18/
DATA NOTICE_TITLE/'Output'/
DATA STRCLASS/'Fully recorded ',
+ 'Spatial overlap ',
+ 'Too wide in phi ',
+ 'Partial on 3 images ',
+ 'Within cusp ',
+ ' '/
C
FIRST = (.NOT.DISP_NOT)
IF (FIRST) THEN
L = LENSTR(NOTICE_TITLE)
CALL XDLF_PARAM_TABLE(IVHNOT,IVHBAS,NOT_X,NOT_Y,1,
$ MAX_NOT_COL,MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ MAX_NOT_STR, XDLSTR(NOTICE_TITLE),L,NOT_FONT,NOT_MENU,IERR)
IF (IERR .NE. 0) THEN
GO TO 999
ENDIF
ENDIF
C
REPLACE = .TRUE.
IXTRUE = IX1
IF (INVERTX) IXTRUE = NREC - IXTRUE + 1
C
WRITE(LINE,'(A,3X,2I5)')
$ 'Pixel X,Y ',IXTRUE,IY1
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_PIXR, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
CALL PX2XYC(XC, YC, IX1, IY1)
XTRUE = XC
IF (INVERTX) XTRUE = NREC*RAST - XTRUE
WRITE(LINE,'(A,3X,2F6.1)') 'XC,YC mm', XTRUE, YC
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_XYC, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,F10.2)') 'Resolution',RESOL
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_RESO, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,3I4)') 'Indices ',(IHKL(I),I=1,3)
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_HKL, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- IHKL(5) is the IR flag for this reflection.
C Reflection flags (IR) (Set by SPTEST called from DSTAR)
C IR = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C A value of 1000 means the reflection was not found
C
PHISP = 0.0
WIDSP = 0.0
INTPR = 0
ISIGPR = 0
IFLAG = 0
IF (IRECG.GT.0) THEN
PHISP = PHIG(IRECG)
WIDSP = PHIWG(IRECG)
IF (PLRESID) THEN
INTPR = IPRO(IRECG)
ISIGPR = ISDPRO(IRECG)
IFLAG = IGFLAG(I)
END IF
END IF
IF ((IHKL(5).GT.20).AND.(IHKL(5).NE.1000)) THEN
WRITE(LINE,'(A,F7.2,A,F5.2)') 'P Phi',PHISP,' width',WIDSP
ELSE
IPOINT = IHKL(5)
IF (IPOINT.EQ.0) THEN
IPOINT = 1
ELSE IF ((IPOINT.EQ.5).OR.(IPOINT.EQ.6)) THEN
IPOINT = 4
ELSE IF (IPOINT.EQ.10) THEN
IPOINT = 5
ELSE IF ((IPOINT.NE.3).AND.(IPOINT.NE.2)) THEN
IPOINT = 6
END IF
IF (IPOINT.EQ.1) THEN
WRITE(LINE,'(A,F7.2,A,F5.2)') 'F Phi',PHISP,' width',WIDSP
ELSE
WRITE(LINE,'(A)') STRCLASS(IPOINT)
END IF
END IF
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_CLASS, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C---- Intensity (profile fitted)
C Check for overload
C
IF (INTPR.EQ.-9999) THEN
WRITE(LINE,'(A)') 'Rejected reflection '
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_INT, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C Sigma (profile fitted)
WRITE(LINE,'(A)') 'Sigma '
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_SD, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
ELSE IF (INTPR.EQ.999999) THEN
WRITE(LINE,'(A)') 'Intensity Overload'
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_INT, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C Sigma (profile fitted)
WRITE(LINE,'(A)') 'Sigma '
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_SD, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
ELSE
WRITE(LINE,'(A,3X,I10)') 'Intensity ',INTPR
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_INT, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C Sigma (profile fitted)
IF (ISIGPR.EQ.-9999) THEN
WRITE(LINE,'(A)') 'flagged as bad spot '
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_SD, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
ELSE
WRITE(LINE,'(A,3X,I10)') 'Sigma ',ISIGPR
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_SD, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C ...blank...
WRITE(LINE,'(A)') ' '
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_BLNK, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,F10.3)') 'Spacing A',SPACNG
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_SPCN, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,F10.1)') 'Average ',AVG
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_STAT, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,F10.1)') 'Rms ',RMS
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_RMS, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,I10)') 'Number ',N
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_NPX, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,I10)') 'Zoomfactor',NZOOM
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_ZOOM, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Circle resolution A '
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_RLAB, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
WRITE(LINE,'(3X,4F5.1)') RESCIR
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_RCIR, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
WRITE(LINE,'(A,3X,2F8.2)') 'Phi ',PHIBEG,PHIEND
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_PHI, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Missets ThetaX,Y,Z'
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_THETA, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
WRITE(LINE,'(3F7.2)') DELPHI
CALL MXDPVL(IVHNOT, REPLACE, LABEL, LINE, NOT_DELPHI, ' ', IERR)
IF (IERR .NE. 0) GO TO 999
C
DISP_NOT = .TRUE.
RETURN
999 CALL MXDERR('MXDNOT: Error',1,IERR)
END
C
C
c
SUBROUTINE MXDPAR(
$ LDSPSG,JDSPAU,IEXTYZ,JIMGN,
$ DISTANCE,THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
C ===========================================================
C
c Set up parameter area for display parameters
c
c ldspsg .true. if image unsigned, .false. if signed
c jdspau auto flag, .gt. 0 for auto, .lt. no auto display
c |jdspau| = image display interval
c iextyz(2) area of pixels to print from Pick
c jimgn(2) (1) 1st image number
c (2) number of images (for Add)
c distance detector distance (mm)
c theta detector angle (degress)
c wavelength wavelength (A)
c rescmx maximum resolution for circles
c
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
INTEGER JIMGN(2),JDSPAU,IEXTYZ(2)
REAL DISTANCE,THETA,WAVELENGTH,RESCMX
LOGICAL LDSPSG,LHELP,LPREF,LPINTG,LPAUSE
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
c
CHARACTER*40 PARAM_TITLE
CHARACTER*80 LINE, VALUE
C
C
INTEGER IPA,IPB,IPC,IPAL,IPBE,IPGA,
+ IPPSIX,IPPSIY,IPPSIZ,
+ IPETA,IPDIVH,IPDIVV,
+ IPLA,IPDIST,IPXCEN,IPCCOM,IPYCEN,IPROFF,IPTOFF,
+ IPYSCAL,IPPICKX,IPPICKY,IPTHRESH,IPSCAL,ITHETA,IPRESO,
+ IPSPF,IPTHRSP,IPRMIN,IPRMAX,IPXOFF,IPYOFF,IPMINX,IPMAXX,
+ IPMINY,IPMAXY,IPMINPX,IPXSPLT,IPYSPLT,IPAUT,IPATHRESH,
+ IPBLANK,IPHELP,IPUPDATE,IPPREF,IPPINTG,IBLANK,IPAUSE
C
INTEGER L, M, IERR, ITOG
INTEGER NITEMS, ITEMLIST(2)
C
REAL DTOR,ETAD,DIVHD,DIVVD,XTRUE,OMEGA0,X
REAL PSI(3)
INTEGER LENSTR
EXTERNAL LENSTR
C
LOGICAL FIRST
SAVE
C
C---- **** IMPORTANT *** if IPAUSE is changed, then also change it in mosflm.f
C
DATA PARAM_TITLE/'Processing params '/
DATA IPA,IPB,IPC,IPAL,IPBE,IPGA,
+ IPPSIX,IPPSIY,IPPSIZ,
+ IPETA,IPDIVH,IPDIVV,
+ IPLA,IPDIST,IPXCEN,IPYCEN,IPCCOM,IPROFF,IPTOFF,
+ IPYSCAL,IPPICKX,IPPICKY,IPTHRESH,IPSCAL,ITHETA,IPRESO,
+ IPSPF,IPTHRSP,IPRMIN,IPRMAX,IPXOFF,IPYOFF,IPMINX,IPMAXX,
+ IPMINY,IPMAXY,IPMINPX,IPXSPLT,IPYSPLT,
+ IPAUT,IPATHRESH,IPBLANK,IPHELP,IPUPDATE,IPPREF,IPPINTG,
+ IBLANK,IPAUSE
+ /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
+ 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,
+ 40,41,42,43,44,45,46,47,48/
C
FIRST = (.NOT.DISP_PAR)
C
IF (FIRST) THEN
L = LENSTR(PARAM_TITLE)
CALL XDLF_PARAM_TABLE(IVHPAR,IVHBAS,PAR_X,PAR_Y,1,
$ MAX_PAR_COL,MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ MAX_PAR_STR, XDLSTR(PARAM_TITLE),L,PAR_FONT,PAR_MENU,IERR)
IF (IERR .NE. 0) THEN
CALL MXDERR('MXDPAR: error',1,ierr)
ENDIF
ENDIF
C
C
LINE = 'a :'
WRITE (VALUE,'(F7.2)') CELL(1)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPA, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'b :'
WRITE (VALUE,'(F7.2)') CELL(2)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPB, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'c :'
WRITE (VALUE,'(F7.2)') CELL(3)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPC, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'alpha :'
WRITE (VALUE,'(F7.2)') CELL(4)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPAL, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'beta :'
WRITE (VALUE,'(F7.2)') CELL(5)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPBE, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'gamma :'
WRITE (VALUE,'(F7.2)') CELL(6)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPGA, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
C
LINE = 'PsiX :'
WRITE (VALUE,'(F7.2)') PSI(1)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPPSIX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'PsiY :'
WRITE (VALUE,'(F7.2)') PSI(2)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPPSIY, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'PsiZ :'
WRITE (VALUE,'(F7.2)') PSI(3)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPPSIZ, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- Mosaic spread and divergences are stored internally as half
C widths in radians
C
DTOR = 4.0*ATAN(1.0)/180.0
ETAD = 2.0*ETA/DTOR
DIVHD = 2.0*DIVH/DTOR
DIVVD = 2.0*DIVV/DTOR
C
LINE = 'Mosaic :'
WRITE (VALUE,'(F7.3)') ETAD
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPETA, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Divh :'
WRITE (VALUE,'(F7.3)') DIVHD
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPDIVH, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Divv :'
WRITE (VALUE,'(F7.3)') DIVVD
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPDIVV, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Lambda :'
WRITE (VALUE,'(F7.3)') WAVE
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPLA, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Distance:'
WRITE (VALUE,'(F7.2)') XTOFD*XTOFRA*0.01
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPDIST, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Beam X :'
XTRUE = 0.01*XCEN
IF (INVERTX) XTRUE = NREC*RAST - XTRUE
WRITE (VALUE,'(F7.2)') XTRUE
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPXCEN, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = ' Y :'
WRITE (VALUE,'(F7.2)') 0.01*YCEN/YSCAL
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPYCEN, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'CCOMEGA :'
OMEGA0 = ATAN2(SINOM0,COSOM0)
IF (OMEGA0.LT.0) OMEGA0 = OMEGA0 + 8.0*ATAN(1.0)
CCOM = (OMEGA0-OMEGAF)/DTOR
WRITE (VALUE,'(F7.3)') CCOM
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPCCOM, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'ROFF :'
WRITE (VALUE,'(F7.2)') 0.01*ROFF
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPROFF, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'TOFF :'
WRITE (VALUE,'(F7.2)') 0.01*TOFF
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPTOFF, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'YSCAL :'
WRITE (VALUE,'(F7.4)') YSCAL
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPYSCAL, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Pick area: X:'
WRITE (VALUE,'(I7)') IEXTYZ(2)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPPICKX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = ' Y:'
WRITE (VALUE,'(I7)') IEXTYZ(1)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPPICKY, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Pick area: X:'
WRITE (VALUE,'(I7)') IEXTYZ(2)
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPPICKX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Int threshold:'
WRITE (VALUE,'(I7)') ITHRESH
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPTHRESH, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Vector scale'
WRITE (VALUE,'(I7)') IRSCAL
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPSCAL, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Two theta'
WRITE (VALUE,'(F7.2)') THETA
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, ITHETA, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Resolution'
IF (ANITES)THEN
WRITE (VALUE,'(''ANISO'')')
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPRESO, VALUE, IERR)
ELSE
X = 0.0
IF (DSTMAX.GT.0) X = WAVE/DSTMAX
WRITE (VALUE,'(F7.2)') X
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPRESO, VALUE, IERR)
ENDIF
IF (IERR .NE. 0) GO TO 999
C
LINE = '*SPOT SEARCH*'
VALUE = ' '
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPSPF, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Threshold'
WRITE (VALUE,'(F7.2)') THRESH
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPTHRSP, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Rmin'
WRITE (VALUE,'(F7.2)') RMINSP
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPRMIN, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Rmax'
WRITE (VALUE,'(F7.2)') RMAXSP
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPRMAX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'X offset'
WRITE (VALUE,'(F7.2)') XOFFSET
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPXOFF, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Y offset'
WRITE (VALUE,'(F7.2)') YOFFSET
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPYOFF, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Min X size'
WRITE (VALUE,'(F7.2)') CUTWXMIN
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPMINX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Max X size'
WRITE (VALUE,'(F7.2)') CUTWXMAX
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPMAXX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Min Y size'
WRITE (VALUE,'(F7.2)') CUTWYMIN
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPMINY, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Max Y size'
WRITE (VALUE,'(F7.2)') CUTWYMAX
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPMAXY, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
LINE = 'Min no of pix'
WRITE (VALUE,'(I7)') NPIXMIN
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPMINPX, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
C
LINE = 'X splitting'
WRITE (VALUE,'(F7.2)') XSPLIT
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPXSPLT, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = 'Y splitting'
WRITE (VALUE,'(F7.2)') YSPLIT
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPYSPLT, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = '*AUTOINDEXING*'
VALUE = ' '
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPAUT, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
C
C
LINE = 'Min I/sig(I):'
WRITE (VALUE,'(I7)') ITHRESH
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPATHRESH, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = 'Prompts'
IF (LHELP) THEN
ITOG = 1
ELSE
ITOG = 2
END IF
IF (FIRST)
+ CALL MXDPVL(IVHPAR, .TRUE., ITOG, LINE, IPHELP, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = 'Update display:'
VALUE = ' '
CALL MXDPVL(IVHPAR, FIRST, 0, LINE, IPUPDATE, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = 'After refinement'
IF (LPREF) THEN
ITOG = 3
ELSE
ITOG = 4
END IF
IF (FIRST)
+ CALL MXDPVL(IVHPAR, .TRUE., ITOG, LINE, IPPREF, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = 'After integration'
IF (LPINTG) THEN
ITOG = 3
ELSE
ITOG = 4
END IF
IF (FIRST)
+ CALL MXDPVL(IVHPAR, .TRUE., ITOG, LINE, IPPINTG, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
LINE = 'Timeout mode'
IF (LPAUSE) THEN
ITOG = 1
ELSE
ITOG = 2
END IF
IF (FIRST)
+ CALL MXDPVL(IVHPAR, .TRUE., ITOG, LINE, IPAUSE, VALUE, IERR)
IF (IERR .NE. 0) GO TO 999
DISP_PAR = .TRUE.
C
RETURN
999 CALL MXDERR('MXDPAR: ERROR ',1,IERR)
END
SUBROUTINE MXDPIN(IX,IY,IEXTYZ,
$ DISTANCE,THETA,WAVELENGTH,RESCMX,PSI,
$ NEWRES,NEWSCL,NTHRESH,NSCAL,MODE,POWDER,MODESP,LHELP,IDIST,
+ IBEAM,LPREF,LPINTG,LPAUSE,NEWCELL,NPSI,RFRESH,INRES)
C ==========================================================
C
C Read parameter
C
C a
C b
C c
C alpha
C beta
C gamma
C psix
C psiy
C psiz
C eta
C divh
C divv
C lambda
C distance
C Direct beam X
C Direct beam Y
C Ccomega
C Roff
C Toff
C Yscale
C Pick size in X
C Pick size in Y
C Threshold (for displaying spots and residual vectors)
C Scale for residual vectors
C Two theta (swing angle)
C Resolution
C Spot Finding
C Threshold for finding spots
C Rmin
C Rmax
C Xoffset
C Yoffset
C Min X size (as function of median)
C Max X size
C Min Y size
C Max Y size
C Min pixels
C X split
C Y split
C Autoindexing
C Min I/sig(I)
C Prompts
C Update display:
C After ref
C After intg
c
c iextyz(2) area of pixels to print from Pick
c distance detector distance (mm)
c theta detector angle (degrees)
c wavelength wavelength (A)
c rescmx maximum resolution for circles
c
c Output
c newres = .true. if pattern need to be recalculated
c newscl = .true. if image scale changed, else left unchanged
c nthresh = .true. if threshold changed for spot list
C RFRESH = .true. if param table need to be refreshed
C because a non-adjustable parameter has
C been selected.
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM = 200)
C ..
C .. Scalar Arguments ..
INTEGER IX, IY,MODE,IXCEN,IYCEN,MODESP,
+ IDIST,IBEAM,INRES
REAL DISTANCE,THETA,WAVELENGTH,RESCMX
LOGICAL NEWRES, NEWSCL, NTHRESH, NSCAL,
+ POWDER,LHELP,XBMSET,YBMSET,LPREF,LPINTG,LPAUSE,
+ NEWCELL,NPSI,RFRESH
C ..
C .. Array Arguments ..
INTEGER IEXTYZ(2)
REAL PSI(3)
C
C ..
C .. Local Scalars ..
INTEGER IXP,IYP,IBUTTON
INTEGER IRMIN,IRMAX
REAL YBEAM,XBEAM,SAVE,DELR,T,THETAMAX,RPLUS,RESO,THPLUS
C
C ..
C .. Local Arrays ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/postchk.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file postchk.h
C---- START of include file postchk.h
C
C DELPHIV stores the missets for the first NADD images only,
C so that once NADD images have been processed their
C refined missets can be saved for writing to the
C summary file.
C
C .. Arrays in Common /POSTCHK/
REAL SDBEAM,SDCELL,SDDELPHI,DELPHIV,SHIFT
LOGICAL FCELL
C
C .. Scalars in Common /POSTCHK/ ..
C ..
REAL PRRES1,PRRES2,RESIDMAX,SDFAC,SHIFTMAX,SHIFTFAC,
+ ANGWIDTH,CELLSHIFT,FRACMIN,FRACMAX,FRCSHIFT
INTEGER PRNS,NREFPR,NADD,NRPT,IPRINTP,NPRMIN
LOGICAL USEBEAM,REFCELL
C ..
C .. Common block /POSTCHK/ ..
COMMON /POSTCHK/ SDBEAM(6),SDCELL(6),SDDELPHI(2*NIMAX),
+ DELPHIV(3*NIMAX),SHIFT(3),PRRES1,PRRES2,RESIDMAX,
+ SDFAC,SHIFTMAX,SHIFTFAC,ANGWIDTH,CELLSHIFT,
$ FRACMIN,FRACMAX,FRCSHIFT,
+ PRNS,NREFPR,NADD,NRPT,IPRINTP,
+ NPRMIN,FCELL(6),USEBEAM,REFCELL
C ..
C
C
C&&*&& end_include ../inc/postchk.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
c
INTEGER ITEM, L, LN, IERR, IDUM, J, M
CHARACTER*80 LINE,CVALUE
REAL DUMMY, A, DTOR,OMEGA0, RSDMAX, ANGLE
LOGICAL INVALID
C
INTEGER LENSTR
EXTERNAL LENSTR
C
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
REAL ETAD,DIVHD,DIVVD,XX
LOGICAL ONLINE
INTEGER NITEMS, ITEMLIST(2)
CAL ** Get rid of this later
REAL PHIRNG(2)
INTEGER IPA,IPB,IPC,IPAL,IPBE,IPGA,
+ IPPSIX,IPPSIY,IPPSIZ,
+ IPETA,IPDIVH,IPDIVV,
+ IPLA,IPDIST,IPXCEN,IPYCEN,IPCCOM,IPROFF,IPTOFF,
+ IPYSCAL,IPPICKX,IPPICKY,IPTHRESH,IPSCAL,IPTHETA,IPRESO,
+ IPSPF,IPTHRSP,IPRMIN,IPRMAX,IPXOFF,IPYOFF,IPMINX,IPMAXX,
+ IPMINY,IPMAXY,IPMINPX,IPXSPLT,IPYSPLT,IPAUT,IPATHRESH,
+ IPBLANK,IPHELP,IPUPDATE,IPPREF,IPPINTG,IBLANK,IPAUSE
SAVE XBMSET,YBMSET
DATA IPA,IPB,IPC,IPAL,IPBE,IPGA,
+ IPPSIX,IPPSIY,IPPSIZ,
+ IPETA,IPDIVH,IPDIVV,
+ IPLA,IPDIST,IPXCEN,IPYCEN,IPCCOM,IPROFF,IPTOFF,
+ IPYSCAL,IPPICKX,IPPICKY,IPTHRESH,IPSCAL,IPTHETA,IPRESO,
+ IPSPF,IPTHRSP,IPRMIN,IPRMAX,IPXOFF,IPYOFF,IPMINX,IPMAXX,
+ IPMINY,IPMAXY,IPMINPX,IPXSPLT,IPYSPLT,
+ IPAUT,IPATHRESH,IPBLANK,IPHELP,IPUPDATE,IPPREF,IPPINTG,
+ IBLANK,IPAUSE
+ /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
+ 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,
+ 40,41,42,43,44,45,46,47,48/
DATA XBMSET/.FALSE./,YBMSET/.FALSE./
C
ONLINE = .TRUE.
NEWCELL = .FALSE.
NPSI = .FALSE.
DTOR = 4.0*ATAN(1.0)/180.0
RFRESH = .FALSE.
C
L = LEN(LINE)
CALL XDLF_PARAM_TABLE_GETVALUE(
$ IVHPAR, ITEM, XDLSTR(LINE), L, IERR)
LN = LENSTR(LINE)
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
C
C---- Parameter table picked, read parameter, but do not allow parameters
C to be updated when inspecting image after integration (MODE=5) or
C after refinement (MODE=4)
C
IF ((((MODE.EQ.5).OR.(MODE.EQ.4)).AND.(.NOT.POWDER))
+ .AND.((ITEM.NE.IPTHRESH).AND.(ITEM.NE.IPSCAL)
+ .AND.(ITEM.NE.IPPICKX).AND.(ITEM.NE.IPPICKY)
+ .AND.(ITEM.NE.IPHELP).AND.(ITEM.NE.IPPREF)
+ .AND.(ITEM.NE.IPPINTG).AND.(ITEM.NE.IBLANK)
+ .AND.(ITEM.NE.IPAUSE))) THEN
LINE = 'Only Threshold and Vector scale may be updated'//
+ ' after integration'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
RFRESH = .TRUE.
RETURN
END IF
C
C Cell a
C
IF (ITEM .EQ. IPA) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
IF (VALUE(1).LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
CELL(1) = VALUE(1)
NEWRES = .TRUE.
NEWCELL = .TRUE.
END IF
WRITE (CVALUE,'(F7.2)') CELL(1)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- If symmetry requires, update other cell parameters
C
IF (ICRYST.GE.4) THEN
CELL(2) = CELL(1)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPB,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
IF (ICRYST.GE.7) THEN
CELL(3) = CELL(1)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPC,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Cell b
C
ELSE IF (ITEM .EQ. IPB) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
CELL(2) = VALUE(1)
NEWRES = .TRUE.
NEWCELL = .TRUE.
END IF
WRITE (CVALUE,'(F7.2)') CELL(2)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPB,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- If symmetry requires, update other cell parameters
C
IF (ICRYST.GE.4) THEN
CELL(1) = CELL(2)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
IF (ICRYST.GE.7) THEN
CELL(3) = CELL(2)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPC,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Cell C
C
ELSE IF (ITEM .EQ. IPC) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
CELL(3) = VALUE(1)
NEWRES = .TRUE.
NEWCELL = .TRUE.
END IF
WRITE (CVALUE,'(F7.2)') CELL(3)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPC,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- If symmetry requires, update other cell parameters
C
IF (ICRYST.GE.7) THEN
CELL(1) = CELL(3)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
CELL(2) = CELL(3)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPB,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Cell alpha
C
ELSE IF (ITEM .EQ. IPAL) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
ANGLE = VALUE(1)
INVALID = (ANGLE.LE.0.0)
IF ((ICRYST.GE.2).AND.(ICRYST.NE.8))
+ INVALID = (ANGLE.NE.90.0)
IF (INVALID) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
CELL(4) = VALUE(1)
NEWRES = .TRUE.
NEWCELL = .TRUE.
END IF
WRITE (CVALUE,'(F7.2)') CELL(4)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPAL,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
IF (ICRYST.EQ.8) THEN
CELL(5) = CELL(4)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPBE,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
CELL(6) = CELL(4)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPGA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Cell beta
C
ELSE IF (ITEM .EQ. IPBE) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
ANGLE = VALUE(1)
INVALID = (ANGLE.LE.0.0)
IF ((ICRYST.GE.3).AND.(ICRYST.NE.8))
+ INVALID = (ANGLE.NE.90.0)
IF (INVALID) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
CELL(5) = VALUE(1)
NEWRES = .TRUE.
NEWCELL = .TRUE.
END IF
WRITE (CVALUE,'(F7.2)') CELL(5)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPBE,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
IF (ICRYST.EQ.8) THEN
CELL(4) = CELL(5)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPAL,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
CELL(6) = CELL(5)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPGA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Cell gamma
C
ELSE IF (ITEM .EQ. IPGA) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
ANGLE = VALUE(1)
INVALID = (ANGLE.LE.0.0)
IF ((ICRYST.EQ.2).OR.(ICRYST.EQ.3).OR.(ICRYST.EQ.4)
+ .OR.(ICRYST.EQ.7)) THEN
INVALID = (ANGLE.NE.90.0)
ELSE IF ((ICRYST.EQ.5).OR.(ICRYST.EQ.6)) THEN
INVALID = (ANGLE.NE.120.0)
END IF
IF (INVALID) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
CELL(6) = VALUE(1)
NEWRES = .TRUE.
NEWCELL = .TRUE.
END IF
WRITE (CVALUE,'(F7.2)') CELL(6)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPGA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
IF (ICRYST.EQ.8) THEN
CELL(4) = CELL(6)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPAL,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
CELL(5) = CELL(6)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPBE,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C PSIX
C
ELSE IF (ITEM .EQ. IPPSIX) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
PSI(1) = VALUE(1)
NEWRES = .TRUE.
NPSI = .TRUE.
WRITE (CVALUE,'(F7.2)') PSI(1)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPPSIX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C PSIY
C
ELSE IF (ITEM .EQ. IPPSIY) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
PSI(2) = VALUE(1)
NEWRES = .TRUE.
NPSI = .TRUE.
WRITE (CVALUE,'(F7.2)') PSI(2)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPPSIY,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C PSIZ
C
ELSE IF (ITEM .EQ. IPPSIZ) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
PSI(3) = VALUE(1)
NEWRES = .TRUE.
NPSI = .TRUE.
WRITE (CVALUE,'(F7.2)') PSI(3)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPPSIZ,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Mosaic
C
ELSE IF (ITEM .EQ. IPETA) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LT.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ETAD = 2*ETA/DTOR
ELSE
ETAD = VALUE(1)
C
C---- Reset postchk max residual. First work out RSDMAX (defaults to 0.33 but
C can be reset by keyword) from the value of RESIDMAX. Trap case
C where input ETA,DIVH,DIVV all zero.
C
XX = (2.0*(ETA + 0.5*(DIVH+DIVV)))
IF (XX.GT.0.0) THEN
RSDMAX = RESIDMAX*DTOR/XX
ELSE
RSDMAX = 0.33
END IF
ETA = 0.5*ETAD*DTOR
RESIDMAX = RSDMAX*2.0*(ETA + 0.5*(DIVH+DIVV))/DTOR
NEWRES = .TRUE.
WARN(26) = .FALSE.
LOGETA = .FALSE.
END IF
WRITE (CVALUE,'(F7.3)') ETAD
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPETA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Divh
C
ELSE IF (ITEM .EQ. IPDIVH) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LT.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
DIVHD = 2*DIVH/DTOR
ELSE
DIVHD = VALUE(1)
C
C---- Reset postchk max residual. First work out RSDMAX (defaults to 0.33 but
C can be reset by keyword) from the value of RESIDMAX. Trap case
C where input ETA,DIVH,DIVV all zero.
C
XX = (2.0*(ETA + 0.5*(DIVH+DIVV)))
IF (XX.GT.0.0) THEN
RSDMAX = RESIDMAX*DTOR/XX
ELSE
RSDMAX = 0.33
END IF
DIVH = 0.5*DIVHD*DTOR
RESIDMAX = RSDMAX*2.0*(ETA + 0.5*(DIVH+DIVV))/DTOR
NEWRES = .TRUE.
WARN(26) = .FALSE.
END IF
WRITE (CVALUE,'(F7.3)') DIVHD
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPDIVH,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Divv
C
ELSE IF (ITEM .EQ. IPDIVV) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LT.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
DIVVD = 2.0*DIVV/DTOR
ELSE
DIVVD = VALUE(1)
C
C---- Reset postchk max residual. First work out RSDMAX (defaults to 0.33 but
C can be reset by keyword) from the value of RESIDMAX. Trap case
C where input ETA,DIVH,DIVV all zero.
C
XX = (2.0*(ETA + 0.5*(DIVH+DIVV)))
IF (XX.GT.0.0) THEN
RSDMAX = RESIDMAX*DTOR/XX
ELSE
RSDMAX = 0.33
END IF
DIVV = 0.5*DIVVD*DTOR
RESIDMAX = RSDMAX*2.0*(ETA + 0.5*(DIVH+DIVV))/DTOR
NEWRES = .TRUE.
WARN(26) = .FALSE.
END IF
WRITE (CVALUE,'(F7.3)') DIVVD
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPDIVV,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Lambda
C
ELSE IF (ITEM .EQ. IPLA) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
WAVE = VALUE(1)
WAVELENGTH = WAVE
NEWRES = .TRUE.
IIWAVE = .TRUE.
END IF
WRITE (CVALUE,'(F7.3)') WAVE
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPLA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Distance
C
ELSE IF (ITEM .EQ. IPDIST) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
DISTANCE = VALUE(1)
IF (DISTANCE.LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
DISTANCE = 0.01*XTOFD
ELSE
XTOFD = 100*DISTANCE
NEWRES = .TRUE.
IDIST = 1
C
C---- Need to set XTOFRA to 1.0 so this is the distance that is actually used
C
XTOFRA = 1.0
END IF
WRITE (CVALUE,'(F7.2)') DISTANCE
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPDIST,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Direct beam X coord
C
ELSE IF (ITEM .EQ. IPXCEN) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
XBEAM = VALUE(1)
IF (XBEAM.LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
XBEAM = 0.01*XCEN
IF (INVERTX) XBEAM = NREC*RAST - XBEAM
ELSE
XCEN = 100*XBEAM
IF (INVERTX) XCEN = 100.0*NREC*RAST - XCEN
XBMSET = .TRUE.
IF (YBMSET) IBEAM = 1
END IF
WRITE (CVALUE,'(F7.2)') XBEAM
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPXCEN,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Direct beam Y coord
C
ELSE IF (ITEM .EQ. IPYCEN) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
YBEAM = VALUE(1)
IF (YBEAM.LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
YBEAM = 0.01*YCEN/YSCAL
ELSE
YCEN = 100*YBEAM*YSCAL
YBMSET = .TRUE.
IF (XBMSET) IBEAM = 1
END IF
WRITE (CVALUE,'(F7.2)') YBEAM
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPYCEN,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Ccomega
C
ELSE IF (ITEM .EQ. IPCCOM) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
CCOM = VALUE(1)
OMEGA0 = OMEGAF + CCOM*DTOR
SINOM0 = SIN(OMEGA0)
COSOM0 = COS(OMEGA0)
WRITE (CVALUE,'(F7.3)') CCOM
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPCCOM,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Roff
C
ELSE IF (ITEM .EQ. IPROFF) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
ROFF = 100.0*VALUE(1)
WRITE (CVALUE,'(F7.2)') 0.01*ROFF
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPROFF,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Toff
C
ELSE IF (ITEM .EQ. IPTOFF) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
TOFF = 100.0*VALUE(1)
WRITE (CVALUE,'(F7.2)') 0.01*TOFF
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPTOFF,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Yscale
C
ELSE IF (ITEM .EQ. IPYSCAL) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IF (VALUE(1).LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
YSCAL = VALUE(1)
END IF
WRITE (CVALUE,'(F7.4)') YSCAL
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPYSCAL,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Pick area X
C
ELSE IF (ITEM .EQ. IPPICKX) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
J = VALUE(1)
IF (J .LT. 1 .OR. J .GT. 50) THEN
LINE = '*** Illegal value for pick area ***'
L = LENSTR(LINE)
CALL XDLF_PARAM_TABLE_ERROR(IVHPAR,IPPICKX,XDLSTR(LINE),
$ L, IERR)
IF (IERR .NE. 0) GO TO 999
ELSE
IEXTYZ(2) = J
WRITE (CVALUE,'(I7)') IEXTYZ(2)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPPICKX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Pick area Y
C
ELSE IF (ITEM .EQ. IPPICKY) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
J = VALUE(1)
IF (J .LT. 1 .OR. J .GT. 50) THEN
LINE = '*** illegal value for pick area ***'
L = LENSTR(LINE)
CALL XDLF_PARAM_TABLE_ERROR(IVHPAR,IPPICKY,XDLSTR(LINE),
$ L, IERR)
IF (IERR .NE. 0) GO TO 999
ELSE
IEXTYZ(1) = J
WRITE (CVALUE,'(I7)') IEXTYZ(1)
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPPICKY,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
END IF
C
C Threshold for spots list
C
ELSE IF (ITEM .EQ. IPTHRESH) THEN
NTHRESH = .TRUE.
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
ITHRESH = VALUE(1)
WRITE (CVALUE,'(I7)') ITHRESH
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPTHRESH,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Scalar for residual vectors
C
ELSE IF (ITEM .EQ. IPSCAL) THEN
NSCAL = .TRUE.
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
IRSCAL = VALUE(1)
WRITE (CVALUE,'(I7)') IRSCAL
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPSCAL,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Two Theta (Swing angle)
C
ELSE IF (ITEM .EQ. IPTHETA) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
THETA = VALUE(1)
WRITE (CVALUE,'(F7.2)') THETA
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPTHETA,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
TWOTHETA = THETA
NEWRES = .TRUE.
END IF
C
C Resolution
C
ELSE IF (ITEM .EQ. IPRESO) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
IF (VALUE(1).LE.0.0) THEN
LINE = 'Not a valid value, original value restored'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
ELSE
RESO = VALUE(1)
END IF
DSTMAX = WAVE/RESO
DSTMAXS = DSTMAX
IIRES = .TRUE.
DELR = MAX(IXSEP,IYSEP)*2.0
C
C---- If separation not given, assume spot size of 2mm
C
IF (DELR.EQ.0) DELR = 400.0
C
THETAMAX = ASIN(DSTMAX/2.0)
T = TAN(2.0*THETAMAX)
C
RPLUS = XTOFD*T + DELR
IF (XTOFD.GT.0.0) THPLUS = ATAN(RPLUS/XTOFD)*0.5
DSTPL = SIN(THPLUS)*2.0
DSTPL2 = DSTPL*DSTPL
INRES = 2
WRITE (CVALUE,'(F7.2)') RESO
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRESO,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
NEWRES = .TRUE.
ANITES = .FALSE.
END IF
C
C Threshold (finding spots)
C
ELSE IF (ITEM .EQ. IPTHRSP) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
THRESH = VALUE(1)
THRESH = MAX(1.0,THRESH)
WRITE (CVALUE,'(F7.2)') THRESH
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPTHRSP,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 1
ITHSET = 1
END IF
C
C Rmin
C
ELSE IF (ITEM .EQ. IPRMIN) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
SAVE = RMINSP
RMINSP = VALUE(1)
C
C---- Check this does not fall outside scanned area
C
IXCEN = 0.01*XCEN/RAST
IYCEN = 0.01*YCEN/RAST
IRMIN = NINT(RMINSP/RAST)
IRMAX = NINT(RMAXSP/RAST)
IF ((RADX.AND.((IXCEN+IRMIN.LT.1).OR.
+ (IXCEN+IRMIN.GT.NREC))) .OR.
+ (RADY.AND.((IYCEN+IRMIN.LT.1).OR.
+ (IYCEN+IRMIN.GT.IYLEN)))) THEN
LINE = 'Rmin too large, goes outside scanned area'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
RMINSP = SAVE
END IF
WRITE (CVALUE,'(F7.2)') RMINSP
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRMIN,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- If input as negative, negate Rmax also, if positive,
C enforce Rmax positive
C
IF (RMINSP.LT.0) THEN
RMAXSP = -ABS(RMAXSP)
WRITE (CVALUE,'(F7.2)') RMAXSP
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRMAX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
ELSE IF (RMINSP.GT.0.0) THEN
RMAXSP = ABS(RMAXSP)
WRITE (CVALUE,'(F7.2)') RMAXSP
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRMAX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
MODESP = 0
END IF
C
C Rmax
C
ELSE IF (ITEM .EQ. IPRMAX) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
SAVE = RMAXSP
RMAXSP = VALUE(1)
C
C---- Check this does not fall outside scanned area
C
IXCEN = 0.01*XCEN/RAST
IYCEN = 0.01*YCEN/RAST
IRMIN = RMINSP/RAST
IRMAX = RMAXSP/RAST
IF ((RADX.AND.((IXCEN+IRMAX.LT.1).OR.
+ (IXCEN+IRMAX.GT.NREC))) .OR.
+ (RADY.AND.((IYCEN+IRMAX.LT.1).OR.
+ (IYCEN+IRMAX.GT.IYLEN)))) THEN
LINE = 'Rmax too large, goes outside scanned area'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
RMAXSP = SAVE
END IF
WRITE (CVALUE,'(F7.2)') RMAXSP
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRMAX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
C
C---- If input as negative, negate Rmin also
C
IF (RMAXSP.LT.0) THEN
RMINSP = -ABS(RMINSP)
WRITE (CVALUE,'(F7.2)') RMINSP
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRMIN,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
ELSE IF (RMAXSP.GT.0) THEN
RMINSP = ABS(RMINSP)
WRITE (CVALUE,'(F7.2)') RMINSP
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPRMIN,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
MODESP = 0
END IF
C
C X offset
C
ELSE IF (ITEM .EQ. IPXOFF) THEN
RADY = .TRUE.
RADX = .FALSE.
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
XOFFSET = VALUE(1)
WRITE (CVALUE,'(F7.2)') XOFFSET
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPXOFF,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 0
END IF
C
C Y offset
C
ELSE IF (ITEM .EQ. IPYOFF) THEN
RADX = .TRUE.
RADY = .FALSE.
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
YOFFSET = VALUE(1)
WRITE (CVALUE,'(F7.2)') YOFFSET
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPYOFF,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 0
END IF
C
C Min X size
C
ELSE IF (ITEM .EQ. IPMINX) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
CUTWXMIN = VALUE(1)
WRITE (CVALUE,'(F7.2)') CUTWXMIN
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPMINX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 2
END IF
C
C MAX X size
C
ELSE IF (ITEM .EQ. IPMAXX) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
CUTWXMAX = VALUE(1)
WRITE (CVALUE,'(F7.2)') CUTWXMAX
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPMAXX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 2
END IF
C
C Min Y size
C
ELSE IF (ITEM .EQ. IPMINY) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
CUTWYMIN = VALUE(1)
WRITE (CVALUE,'(F7.2)') CUTWYMIN
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPMINY,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 2
END IF
C
C MAX Y size
C
ELSE IF (ITEM .EQ. IPMAXY) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
CUTWYMAX = VALUE(1)
WRITE (CVALUE,'(F7.2)') CUTWYMAX
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPMAXY,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 2
END IF
C
C Minimum no of pixels
C
ELSE IF (ITEM .EQ. IPMINPX) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
NPIXMIN = VALUE(1)
WRITE (CVALUE,'(I7)') NPIXMIN
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPMINPX,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 1
END IF
C
C X splitting
C
ELSE IF (ITEM .EQ. IPXSPLT) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
XSPLIT = VALUE(1)
WRITE (CVALUE,'(F7.2)') XSPLIT
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPXSPLT,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 2
END IF
C
C
C Y splitting
C
ELSE IF (ITEM .EQ. IPYSPLT) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
YSPLIT = VALUE(1)
WRITE (CVALUE,'(F7.2)') YSPLIT
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPYSPLT,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
MODESP = 2
END IF
C
C
C Minimum I/sig(I) for autoindexing
C
ELSE IF (ITEM .EQ. IPATHRESH) THEN
NTHRESH = .TRUE.
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) then
ITHRESH = VALUE(1)
WRITE (CVALUE,'(I7)') ITHRESH
M = LENSTR(CVALUE)
CALL XDLF_PARAM_TABLE_SETVALUE(IVHPAR, IPATHRESH,
$ XDLSTR(CVALUE),M,0,IERR)
IF (IERR .NE. 0) GO TO 999
END IF
C
C Prompts
C
ELSE IF (ITEM .EQ. IPHELP) THEN
LHELP = (.NOT.LHELP)
C
C Return to display after refinement
C
ELSE IF (ITEM .EQ. IPPREF) THEN
LPREF = (.NOT.LPREF)
C
C Return to display after integration
C
ELSE IF (ITEM .EQ. IPPINTG) THEN
LPINTG = (.NOT.LPINTG)
C
C---- PAUSE mode
C
ELSE IF (ITEM .EQ. IPAUSE) THEN
LPAUSE = (.NOT.LPAUSE)
ENDIF
C
RETURN
C
999 CALL MXDERR('MXDPIN: Error',1,IERR)
END
SUBROUTINE MXDPVL(IVH, FIRST, ITOG, LINE, ITEM, VALUE, IERR)
C ============================================================
C
c Create or update parameter value in parameter table
c
c Input:
c ivh view object handle number
c first .true. for first creation of parameter table
c itog toggle value, = 0 if not toggle
c line label string
c item item number
c value value string
c
c Output:
c ierr error flag = 0 if OK
c
IMPLICIT NONE
C
LOGICAL FIRST
CHARACTER*(*) LINE, VALUE
INTEGER IVH, ITOG, ITEM, IERR
C
C
INTEGER L, M
INTEGER LENSTR, XDLSTR
EXTERNAL LENSTR, XDLSTR
C
L = LENSTR(LINE)
M = LENSTR(VALUE)
IF (ITOG .NE. 0) M = 0
IF (FIRST) THEN
CALL XDLF_PARAM_TABLE_SETITEM(IVH, ITEM,
$ XDLSTR(LINE),L,XDLSTR(VALUE),M,ITOG,0,IERR)
ELSE
CALL XDLF_PARAM_TABLE_SETVALUE(IVH, ITEM,
$ XDLSTR(VALUE),M,ITOG,IERR)
ENDIF
C
RETURN
END
C
C
SUBROUTINE MXDRIO(LINE)
C =======================
C
C---- Read line from io window
c
c Returned:
c LINE input string
C
IMPLICIT NONE
C
CHARACTER*(*) LINE
c
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
c
INTEGER LENSTR, L, IERR, NUMVH, IVH,LL
EXTERNAL LENSTR
INTEGER IVHLIST(1)
C
L = 80
C
c
c Wait for input
10 NUMVH = 1
IVHLIST(1) = IVHIO
CALL XDLF_GET_EVENTS(NUMVH, IVHLIST, IVH)
IF (IVH .NE. IVHIO) GO TO 10
CALL XDLF_IO_WINDOW_GETSTRING(IVHIO, XDLSTR(LINE), L, IERR)
CAL LL = LENSTR(LINE)
CAL IF (LL.GT.0) WRITE(IOUT,FMT=100) LINE(1:LL)
100 FORMAT(1X,'Read from window: ',A)
RETURN
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE MXDSPL(MODE,FIRSTPACK,PACK,IFIRSTPACK,FIRSTFILM,
+ GENOPEN)
C ==========================================================
C
C---- DEBUG(65) this S/R
C Last format 6400, last label 192
C
C---- MODE is either returned from MXDSPL or set by calling program
C
C = 0 No special action
C = 1 Do auto-refinement of orientation on returning to main program
C = 2 Display image again after parameter refinement
C = 3 Do auto-refinement and display image after positional refinement
C = 4 Replotting image after positional refinement
C = 5 Examining image after integration. Do not allow updating
C of parameters. Plot badspots, display residual vectors.
C
C = 9 Integrate a series of images
C = 10 Do a POSTREF SEGMENT run
C = 20 Return to CONTROL for a STRATEGY run
C = 99 Abort current run
C---- Note that the starting element in array IMAGE for the image to
C be displayed is ISTART*IYLEN+1
C ISTART is set in subroutine OPENODS
C
C LPINTG is TRUEand if MODE=5, plot residual vectors
C
C FIRSTPACK is TRUE if this is the first image in the generate file
C The AUTOMATCH menu option can only be called for the first image
C (as currently implemented)
C
C
C User graphical interface.
C
C Uses xdl_view routines, John Campbell, Daresbury Laboratory, UK
C
c
c distance detector distance in mm
c theta detector swing angle (degrees)
c wavelength in Angstrom
C
C ITYP =1 Text
C =2 A number
C =3 A quoted token
C
C
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C include file with _all_ local declarations put here 21.06.01 in
C preparation for interface with new GUI
C
C
C---- Integer variables
C
INTEGER IFIRSTPACK,MODE,STHRESH
LOGICAL FIRSTPACK,PACK,FIRSTFILM,GENOPEN
C&&*&& include ../inc/mxdspl.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C---- START of include file mxdspl.h
C
C
C---- PARAMETERS first
C
INTEGER NPARM
PARAMETER (NPARM = 200)
INTEGER MAXSEG
PARAMETER (MAXSEG = 20)
INTEGER NCIRC
PARAMETER (NCIRC=4)
C Circle points
INTEGER MAXCPT
PARAMETER (MAXCPT = 200)
C
INTEGER LCLEAN, IEXTYZ, LCORRC
C
C JIMGN(1) first image number
C JIMGN(2) number of images
INTEGER JIMGN
C
C MENU ITEM NUMBERS
INTEGER MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,MBADSP,
+ MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,MMEAS,
+ MCIRC,MREAD,MFIND,MEDIT,MMOSA,MCLRSPT,MSEL,MAUTO,MPRED,
+ MCLRPRD,MPREF,MINTEG,MSTRAT,MKEYWD,MADJ2,MFHKL,MCIRCF
C Possible ones to be added ?
INTEGER ISCL
C
C Active object list
C ivhlist(1) menu
C ivhlist(2) parameters
C ivhlist(3) image
INTEGER NUMVH, IVHLIST,IVH, NUMVH2, IVHLIST2
c npx number of points in box
INTEGER NPX
INTEGER IVECB, IVECC
C .. local scalars ..
INTEGER I,J,IQUIT,ISTAT,IERR,MEASUR,ITEM,IX,IY,L,M,JY,JZ,NSOL,
$ NADDS,MODEG,NFULLF
INTEGER IX1,IY1,IX2,IY2,JY2,JZ2, IZOOM, MEASPT, NORDER,
+ IXM, IYM, IXP, IYP, KFLAG, IBUTTON,IFLAG, IISIZE,
+ NDISPP,IRECG,IJUNK,IFAIL,NCH,NCH2,MODEOP,ID,NFIRSTI,MODESP,
+ MODECTRL,IPACKF,IPACKL,NSERLOC,LINELEN,NUMLIN,IPAUSE,
+ ICOUNT,JSEG,IM1,JIMAG,K,ICHECK,NTOT,ICOLR,JFIRST,ITOG,
+ IPACK,NPROC,IXCEN,IYCEN,IRMIN,IRMAX,MODEGSR,ISTRTSV,
+ IANGLESV,IFLAGPR,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ MODEDISP,NUMSAVE,NPROFL,NUMBLOCK,IERR2
C Circle points
INTEGER NCIRPT, MCIRPT, IXYCPT, MAXDPT
INTEGER INCIMG,MSECS
INTEGER IADJP,NDISP
C JDSPAU auto display flag, .gt. 0 for image display in
C Find & Collect: display every JDPSAUth image
INTEGER JDSPAU
C .. Local arrays ..
INTEGER IXADJ,IYADJ,IHKL,IHKLX,IMS1,
+ IMF1
C
C things for parser
C
INTEGER IBEG,IDEC,IEND,ITYP
INTEGER NTOK
C
C---- Real variables
C
C Menu
REAL RESCMX
REAL RESCIR
c
c pxavg average of box
c pxrms rms of box
REAL PXAVG, PXRMS
C
C .. Local Scalars ..
REAL PHIBEGS,XSEP,YSEP,OMEGAFD,RX,RY,TOTPHI,PRWIDTH,THETA,
+ OHDIST,X,MAXCELL
c
c Circle points
REAL CIRCEN, CIRRAD
C
C---- Following needed for call to CONTROL
C
REAL DUMMY, RESOL, SPACNG, XMEASPT,RJY,RJZ,DTOR,RAD,
+ PHISTART
C ..
C .. Local Arrays ..
REAL PSI,PHIPRF,OSCPRF
C
C---- Things for parser
C
REAL VALUE
C
C---- now for character variables
C
C Menu
CHARACTER*(MAX_MEN_NAME) MENU_ITEMS,
+ MENU_ITEMS2
C
CHARACTER*(MAX_MEN_NAME) EXIT_NAME
C ..
C .. Local Scalars ..
CHARACTER PROMPT*80, LINE*80, STR*100 ,TEMPCH*100,
+ STR1*1,STR2*4,STR3*4,STR4*7,LINE2*80,SUBKEY*4,KEY*4,
+ BIGLINE*120,STR5*9,VALUESTR*80,WAXFNN*134,MTZNAMP*80
CHARACTER STORIMAG*200
C
C---- Following needed for call to CONTROL
C
CHARACTER CELLSTR*50
C
CHARACTER FNAME
C .. Local Arrays ..
CHARACTER MATFILN*70,IDENTPRF*80
C
C---- finally, LOGICALS
C
LOGICAL CALC_VB1,CALC_VB2
C
C---- local scalars
C
LOGICAL PREDICTED,SNEWGENF,EFILE,GIVEMAT,BOXOPEN,LPRNT,
+ UPDATE,NEWRAST,NEWSEP,FORCEREAD,GENFILESET,BADTOG,
+ NEWCELL,NPSI,BOXOPEN2,RFRESH,SAVED,RFIXCELL,RFIXDIST,
+ NULINE,NEWWIN,AUTOIND,CHRMIN,CHRMAX,ADDSPOTS,AUTOINDS,
+ DEFPHI,GWRITE,DOPROFILE,FAIL,LIST,SNOCENT,SNOREFINE,
$ SRMOSAIC,SFIRSTFILM,SGENOPEN,SFIRSTTIME,smultiseg,
$ JUMPBACK,ADDPP
C Circle points
LOGICAL LFITCIRC
C needed for call to control
LOGICAL FIRSTTIME,NEWGENF,RPTFIRST
LOGICAL LPICK,LPLRNG,PICKED,CIRCLES,NEWRES,NEWSCL,LAUTOM,LPRKBC,
+ LIN1,ADJUST,LINDEX,LSPOT,LSPEDIT,LKILL,NTHRESH,NSCAL,MENU2,
+ ROTATED,NEWSPOTS,LBADSP,LDISPSPT
LOGICAL DPS_INDEX,DPS_SEARCH
C .. local arrays ..
LOGICAL INMAT
COMMON /GUIVAR/LCLEAN(3),IEXTYZ(2),LCORRC,
$ JIMGN(2),MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,
+ MBADSP,MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,
+ MMEAS,MCIRC,MREAD,MFIND,MEDIT,MMOSA,MCLRSPT,MSEL,MAUTO,
+ MPRED,MCLRPRD,MPREF,MINTEG,MSTRAT,MKEYWD,MADJ2,MFHKL,
$ MCIRCF,ISCL,NUMVH,IVHLIST(3),IVH,NUMVH2,IVHLIST2(3),NPX,
$ IVECB,IVECC,I,J,IQUIT,ISTAT,IERR,MEASUR,ITEM,IX,IY,L,M,JY,
$ JZ,NSOL,NADDS,MODEG,NFULLF,
$ IX1,IY1,IX2,IY2,JY2,JZ2, IZOOM, MEASPT(2,2), NORDER,
+ IXM, IYM, IXP, IYP, KFLAG, IBUTTON,IFLAG, IISIZE,
+ NDISPP,IRECG,IJUNK,IFAIL,NCH,NCH2,MODEOP,ID,NFIRSTI,
+ MODESP,MODECTRL,IPACKF,IPACKL,NSERLOC,LINELEN,NUMLIN,
+ IPAUSE,ICOUNT,JSEG,IM1,JIMAG,K,ICHECK,NTOT,ICOLR,JFIRST,
+ ITOG,IPACK,NPROC,IXCEN,IYCEN,IRMIN,IRMAX,MODEGSR,ISTRTSV,
+ IANGLESV,IFLAGPR,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,
+ MODEDISP,NUMSAVE,NPROFL,NUMBLOCK,IERR2,NCIRPT,
$ MCIRPT,IXYCPT(2,MAXCPT), MAXDPT,INCIMG,MSECS,IADJP,NDISP,
$ JDSPAU,IXADJ(4),IYADJ(4),IHKL(5),IHKLX(5),IMS1(MAXSEG),
+ IMF1(MAXSEG),IBEG(NPARM),IDEC(NPARM),IEND(NPARM),
$ ITYP(NPARM),NTOK,
$ RESCMX,RESCIR(NCIRC),PXAVG, PXRMS,PHIBEGS,XSEP,YSEP,
$ OMEGAFD,RX,RY,TOTPHI,PRWIDTH,THETA,OHDIST,X,MAXCELL,
$ CIRCEN(2), CIRRAD,DUMMY, RESOL, SPACNG, XMEASPT(2,2),RJY,
$ RJZ,DTOR,RAD,PHISTART,PSI(3),PHIPRF(MAXSEG),
$ OSCPRF(MAXSEG),VALUE(NPARM)
COMMON /GUICHA/ MENU_ITEMS(MAX_MEN_ITMS),
+ MENU_ITEMS2(MAX_MEN_ITMS),
$ EXIT_NAME,
$ PROMPT, LINE, STR ,TEMPCH,
+ STR1,STR2,STR3,STR4,LINE2,SUBKEY,KEY,
+ BIGLINE,STR5,VALUESTR,WAXFNN,MTZNAMP,
$ STORIMAG,CELLSTR,FNAME,MATFILN(MAXSEG),
$ IDENTPRF(MAXSEG)
COMMON /GUILOG/CALC_VB1,CALC_VB2,
$ PREDICTED,SNEWGENF,EFILE,GIVEMAT,BOXOPEN,LPRNT,
+ UPDATE,NEWRAST,NEWSEP,FORCEREAD,GENFILESET,BADTOG,
+ NEWCELL,NPSI,BOXOPEN2,RFRESH,SAVED,RFIXCELL,RFIXDIST,
+ NULINE,NEWWIN,AUTOIND,CHRMIN,CHRMAX,ADDSPOTS,AUTOINDS,
+ DEFPHI,GWRITE,DOPROFILE,FAIL,LIST,SNOCENT,SNOREFINE,
$ SRMOSAIC,SFIRSTFILM,SGENOPEN,SFIRSTTIME,smultiseg,
$ JUMPBACK,ADDPP,LFITCIRC, FIRSTTIME,NEWGENF,RPTFIRST,
$ LPICK,LPLRNG,PICKED,CIRCLES,NEWRES,NEWSCL,LAUTOM,LPRKBC,
+ LIN1,ADJUST,LINDEX,LSPOT,LSPEDIT,LKILL,NTHRESH,NSCAL,
+ MENU2,ROTATED,NEWSPOTS,LBADSP,LDISPSPT,DPS_INDEX,
$ DPS_SEARCH,INMAT(MAXSEG)
C&&*&& end_include ../inc/mxdspl.f
C ..
C .. External Subroutines ..
EXTERNAL GETINDX,PHITOPSI,DSPINI,CRESOL,MXDMNU,MXDPAR,MXDNOT,
+ XDLF_FLUSH_EVENTS,MXDBSY,DSPIMG,DSPPRD,XDLF_GET_EVENTS,
+ XDLF_MENU_AREA_GETITEM,XDLF_MENU_AREA_GETROOTXY,
+ MXDDSY,PREDICT,MXDCIR,DSPADJ,XDLF_POPUP_NOTICE,
+ MXDDLG,MPARSE,MKEYNM,GETPIX,DSPXCRS,MXDCIO,DSPENDEDT,
+ DSPEDT,RDSPOT,DSPSPT,MXDDVC,DSPRSD,DSPBGD,KILLSPT,
+ TOREFIX,MRDSYMM,STRIPSTR,MXDDVN,QCLOSE,GETSEPRAS,
+ GETSPOTS,DSPCIRC,GETBLOCK,XDLF_GET_EVENTS_TIMEOUT,
+ MXDPIN,SETMAT,DSPSEL,MENKW,MENSAVE,WINDIO,OPENODS
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C
C---- need these for WAVE,XTOFD
C
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/postchk.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file postchk.h
C---- START of include file postchk.h
C
C DELPHIV stores the missets for the first NADD images only,
C so that once NADD images have been processed their
C refined missets can be saved for writing to the
C summary file.
C
C .. Arrays in Common /POSTCHK/
REAL SDBEAM,SDCELL,SDDELPHI,DELPHIV,SHIFT
LOGICAL FCELL
C
C .. Scalars in Common /POSTCHK/ ..
C ..
REAL PRRES1,PRRES2,RESIDMAX,SDFAC,SHIFTMAX,SHIFTFAC,
+ ANGWIDTH,CELLSHIFT,FRACMIN,FRACMAX,FRCSHIFT
INTEGER PRNS,NREFPR,NADD,NRPT,IPRINTP,NPRMIN
LOGICAL USEBEAM,REFCELL
C ..
C .. Common block /POSTCHK/ ..
COMMON /POSTCHK/ SDBEAM(6),SDCELL(6),SDDELPHI(2*NIMAX),
+ DELPHIV(3*NIMAX),SHIFT(3),PRRES1,PRRES2,RESIDMAX,
+ SDFAC,SHIFTMAX,SHIFTFAC,ANGWIDTH,CELLSHIFT,
$ FRACMIN,FRACMAX,FRCSHIFT,
+ PRNS,NREFPR,NADD,NRPT,IPRINTP,
+ NPRMIN,FCELL(6),USEBEAM,REFCELL
C ..
C
C
C&&*&& end_include ../inc/postchk.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/restart.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file restart.h
C
C---- Saves image ID, IDENT and phi values in case of an abort or
C when current run has finished, determines which image will be
C displayed with GUI at this point.
C
C .. Scalars in common block /RESTART/ ..
REAL RESTPHIB, RESTPHIE
INTEGER RESTID
CHARACTER RESTIDENT*40,RTEMPLSTART*100,RTEMPLEND*100
C ..
C .. Arrays in common block /RESTART/ ..
C
C .. Common Block /RESTART/ ..
COMMON /RESTART/ RESTPHIB,RESTPHIE,RESTID
C
C
COMMON /RESTARTC/ RESTIDENT,RTEMPLSTART,RTEMPLEND
C ..
C ..
C
C
C&&*&& end_include ../inc/restart.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C&&*&& include ../inc/virbat.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C---- include file header for virtual batches in post-refinement
C
INTEGER NIVB,MAGIC,NVIRBAT,NADDMISSET,IVIRBAT
LOGICAL NUPR_INT
COMMON /VIRBAT/ NIVB,MAGIC,NVIRBAT,NADDMISSET,
+ IVIRBAT,NUPR_INT
C&&*&& end_include ../inc/virbat.f
C&&*&& include ../inc/dpsindex.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file dpsindex.h
C
C
REAL DISTANCE,XTD,WAVELENGTH,XBEAM,YBEAM,PHIAV,DMAX,
$ ORGX,ORGY,XCOR,YCOR
INTEGER*4 IXD,IYD,IPHI,SOLN
INTEGER*2 IH,IK,IL
LOGICAL INDNOREF,DPSINDEX,PREREF,LSOL
COMMON /DPSINDEX/ DISTANCE,XTD,WAVELENGTH,XBEAM,YBEAM,
$ PHIAV,DMAX,ORGX,ORGY,XCOR,YCOR,IXD(5000),
$ IYD(5000),IPHI(5000),SOLN,IH(5000),IK(5000),
$ IL(5000),INDNOREF,DPSINDEX,PREREF,LSOL
C
C
C COMMON BLOCK USED IN PERMUTING THE CELL
C
REAL KCELL(6)
INTEGER KICRYST
COMMON /PERMUTE/ KCELL,KICRYST
C
C
C&&*&& end_include ../inc/dpsindex.f
C ..
SAVE
C .. Data statements ..
DATA LPRNT/.TRUE./,SAVED/.FALSE./
DATA BOXOPEN/.FALSE./,BOXOPEN2/.FALSE./
DATA JIMGN /0, 0/
DATA LCLEAN /40, 40, 1/
DATA IEXTYZ /11,11/
DATA LCORRC/1/
DATA MAXDPT/10/
c
DATA MENU_ITEMS/
+ 'Predict',
+ 'Clear prediction',
+ 'Adjust',
+ 'Auto-refine',
+ 'Continue',
+ 'Find hkl',
+ 'Read spot list',
+ ' ',
+ ' ',
+ ' ',
+ 'Abort ',
+ ' ',
+ ' ',
+ ' ',
+ ' ',
+ 'Pick',
+ 'Measure cell',
+ 'Circles',
+ 'Beam / backstop'/
DATA MENU_ITEMS2/
+ 'Read image',
+ 'Find spots',
+ 'Edit spots',
+ 'Clear spots',
+ 'Select images',
+ 'Autoindex',
+ 'Estimate mosaicity',
+ 'Predict',
+ 'Clear prediction',
+ 'Adjust',
+ 'Refine cell',
+ 'Integrate',
+ 'Strategy',
+ 'Keyword input',
+ 'Find hkl ',
+ 'Pick',
+ 'Measure cell',
+ 'Circles',
+ 'Beam / backstop'/
DATA MPRD,MCLEAR,MADJ,MARF,MINTG,MINDX,MSPOTS,MBLANK1,MBADSP,
+ MBLANK3,MABORT,MBLANK4,MBLANK5,MBLANK6,MZOOM,MPICK,MMEAS,
+ MCIRC,MCIRCF
+ /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19/
DATA MREAD,MFIND,MEDIT,MCLRSPT,MSEL,MAUTO,MMOSA,MPRED,
+ MCLRPRD,MADJ2,MPREF,MINTEG,MSTRAT,MKEYWD,MFHKL
+ /101,102,103,104,105,106,107,108,109,110,111,112,113,114,115/
DATA RESCMX /2.0/, RESCIR/4*0.0/
DATA IVECB, IVECC/1, 2/
DATA INMAT/MAXSEG*.FALSE./
DATA STORIMAG/' '/
DATA GENFILESET/.FALSE./
C
C Initializations
C
NULINE = .TRUE.
DTOR = ATAN(1.0)*4.0/180.0
OMEGAFD = OMEGAF/DTOR
ROTATED = ((ABS(OMEGAFD).LT.1.0).OR.(ABS(OMEGAFD-180).LT.1.0))
FORCEREAD = .FALSE.
LAUTOM = .TRUE.
EXIT_NAME = 'Save/Exit'
NEWRES = .FALSE.
NTHRESH = .FALSE.
NEWRAST = .FALSE.
NEWSEP = .FALSE.
NSCAL = .FALSE.
IJUNK = 0
MENU2 = POWDER
PREDICTED = .FALSE.
RFRESH = .FALSE.
PHIRNG = PHIEND - PHIBEG
LDISPSPT = .FALSE.
LFITCIRC = .FALSE.
NCIRPT = 0
MCIRPT = 0
C
C---- Assign KCELL, used to permute axes if required
C
DO 4 I = 1,6
KCELL(I) = CELL(I)
4 CONTINUE
C
C---- Reset RMINSP,RMAXSP if necessary, as a "Refine cell" option will reset it
C to zero, so set to to 0.05 and 0.45 of image size
C
IF (RMINSP.EQ.0) RMINSP = NREC*RAST*0.05
C
C
C
IF (MODE.EQ.5) THEN
MENU_ITEMS(MBADSP) = 'Bad spots'
ELSE
MENU_ITEMS(MBADSP) = ' '
END IF
IIMAG = 1
CAL Is this OK ?
JDSPAU = 0
CIRCLES = .FALSE.
IZOOM = 0
NZOOM = 0
LPICK = .FALSE.
PICKED = .FALSE.
C
C---- If Pick had been selected in a previous image, set it active
C
IF ((MENU_ITEMS(MPICK)(1:3).EQ.'Can').OR.
+ (MENU_ITEMS2(MPICK)(1:3).EQ.'Can')) THEN
LPICK = .TRUE.
PICKED = .TRUE.
IF (MENU2) THEN
MENU_ITEMS2(MPICK) = 'Cancel pick'
ELSE
MENU_ITEMS(MPICK) = 'Cancel pick'
END IF
END IF
C
MEASUR = 0
LPLRNG = .FALSE.
SPACNG = 0.0
NORDER = 1
PXAVG = 0.0
PXRMS = 0.0
NPX = 0
JY = 0
JZ = 0
IX1 = 0
IY1 = 0
RESOL = 0.0
NEWSCL = .FALSE.
ADJUST = .FALSE.
LINDEX = .FALSE.
LSPOT = .FALSE.
LSPEDIT = .FALSE.
LKILL = .FALSE.
LBADSP = .FALSE.
IRSCAL = 1
C
C---- If in POWDER mode, initialise arrays, set default filename
C
IF (POWDER) THEN
C
C---- If spots have been found previously, give option of deleting them.
CCAL no...not the way to do it !!
CAL IF (NSPTD.GT.0) THEN
CAL IXM = 200
CAL IYM = 200
CAL LINELEN = 75
CAL NUMLIN = 3
C
C Create IO window
C
CAL CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
C---- Do you want to
C
CAL LINE = ' '
CAL WRITE(LINE,FMT=6290)
CAL 6290 FORMAT('Do you want to delete the spots',
CAL + ' found previously (N):')
CAL CALL MXDWIO(LINE, 1)
CAL CALL MXDRIO(LINE2)
C
C---- Parse reply
C
CCAL ******************************************
CAL CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
CAL IF (NTOK.EQ.0) THEN
CAL STR1 = 'N'
CAL ELSE
CAL STR1 = LINE2(IBEG(1):IEND(1))
CAL CALL CCPUPC(STR1)
CAL END IF
CAL CALL MXDCIO(1,0,0,0,0)
C
CAL IF (STR1.EQ.'Y') THEN
CAL DO 2 I = 1,MAXIMG
CAL ISTIMG(I) = 0
CAL IENDIMG(I) = 0
CAL 2 CONTINUE
CAL NSPTD = 0
CAL END IF
CAL END IF
C
C---- Set up new default filename for spots file and matrix. INEWMAT=2
C if a NEWMAT keyword has been given. Note it is set to 1 by "TOREFIX"
C so that once autoindexing has been called it will not be reset to 2.
C
NCH = LENSTR(WAXFN)
IF (NCH.GT.0) THEN
SPTNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.spt'
IF (INEWMAT.NE.2)
+ NEWMATNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.mat'
END IF
END IF
C
C---- Describe colour code
C
IF (.NOT.POWDER) THEN
IF (MODE.EQ.5) THEN
WRITE(ITOUT,FMT=6001)
ELSE
WRITE(ITOUT,FMT=6002)
END IF
END IF
6001 FORMAT(//1X,'In the display of predicted spots, the colour ',
+ 'code is:',/,1X,'Blue Fully recorded reflections',
+ /,1X,'Yellow Partially recorded reflections',
+ /,1X,'Red Rejected spatial overlaps',
+ /,1X,'Green Rejected reflections (too wide)',
+ /,1X,'Green cross (+) overloaded reflection',
+ /,1X,'Blue cross (+) reflection outside scanned area',
+ /,1X,'Red cross (+) bad spot')
6002 FORMAT(//1X,'In the display of predicted spots, the colour ',
+ 'code is:',/,1X,'Blue Fully recorded reflections',
+ /,1X,'Yellow Partially recorded reflections',
+ /,1X,'Red Rejected spatial overlaps',
+ /,1X,'Green Rejected reflections (too wide)',
+ /,1X,'The red circle denotes the region ',
+ 'behind the backstop shadow',/,1X,'(Use BACKSTOP',
+ ' keyword to set this.)')
IF ((POWDER).AND.(RMIN.GT.0)) WRITE(ITOUT,FMT=6005)
6005 FORMAT(/,1X,'The red circle denotes the region ',
+ 'behind the backstop shadow',/,1X,'(Use BACKSTOP',
+ ' keyword to set this.)')
CAL IF (ROTATED) WRITE(ITOUT,FMT=6003)
6003 FORMAT(/,1X,'The image is rotated by 90 degrees so that the ',
+ 'oscillation axis is horizontal',/,1X,
+ 'in the display')
C
C---- Set distance, wavelength, theta
C
DISTANCE = 0.01*XTOFD
WAVELENGTH = WAVE
IF (DISTANCE.EQ.0.0) WRITE(ITOUT,FMT=6000)
6000 FORMAT(//,1X,'*** WARNING ***',/,1X,'Distance has not been set')
IF (WAVELENGTH.EQ.0.0) WRITE(ITOUT,FMT=6010)
6010 FORMAT(//,1X,'*** WARNING ***',/,1X,
+ 'Wavelength has not been set')
C
C---- Get THETA = TWOTHETA from common xy
C
THETA = TWOTHETA
C
C---- Convert missetting angles thetaX,Y,Z to PsiX,Y,Z
C **** To make interactive pattern matching easier to do,
C don't add DELPHI(3)
C PHIAV = (PHIBEG+PHIEND)*0.5 + DELPHI(3)
PHIAV = (PHIBEG+PHIEND)*0.5
C
C **************************
CALL PHITOPSI(DELPHI,PSI,PHIAV)
C **************************
c
c Initialize display stuff
IF (.NOT.WINOPEN) THEN
CALL DSPINI('Image display',.TRUE.,NREC,IYLEN)
WINOPEN = .TRUE.
END IF
C
C---- Set initial outer circle position
C Won't work for offset detector !
C
CALL CRESOL(NXDPX/2,0,DISTANCE,THETA,WAVELENGTH,RESCMX)
c Initialize menu area
IF (POWDER) THEN
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
END IF
C
c Initialize parameter area
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,
+ DISTANCE,THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
c Initialize notice area
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,NZOOM,RESCIR,
+ NCIRC,IHKL,IRECG,LPINTG)
C
C DISPLAY INITIAL FILE
CALL XDLF_FLUSH_EVENTS(I)
C
C---- If just replotting after refinement, don't need to redraw image
C
IF ((MODE.EQ.4).AND.(DISP_IMG)) THEN
C
C---- If this is the first image of a block, and SEPARATION was not
C given explicitly, then it may have changed, changing the
C number of overlaps, so need to repredict now
C
IFLAGPR = 0
IF (FIRSTFILM.AND.(ISEP.NE.2)) CALL PREDICT(PSI,IFLAGPR)
C
C---- Trap too many reflections generated
C
IF (IFLAGPR.LT.0) THEN
WRITE(LINE,FMT=6210) NREFLS
6210 FORMAT('More than',I6,' reflections generated.',
+ 'Recompile increasing parameter NREFLS.')
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
END IF
CALL MXDDVC
ELSE
CALL XDLF_FLUSH_EVENTS(I)
CALL DSPIMG(IMAGE(ISTART*IYLEN+1),NREC,IYLEN,NEWSCL,
+ STORIMAG)
END IF
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Display RMIN circle (backstop shadow)
C Note do not need to apply YSCAL here because in DSPCIRC we will be
C working in image pixels, not mm.
C
ICOLR = 1
IF ((RMINX.NE.0.0).AND.(RMINY.NE.0.0)) THEN
RX = 0.01*RMINX
RY = 0.01*RMINY
ELSE
RX = 0.01*XCEN
RY = 0.01*YCEN
END IF
IF (POWDER) WRITE(ITOUT,FMT=6005)
CALL MXDDVN(CIRC_VEC)
CALL DSPCIRC(RX,RY,0.01*RMIN,ICOLR)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- If displaying after integration, clear predicted pattern
C (box size may be different now)
C
IF (MODE.EQ.5) CALL MXDDVN(BOX_VEC)
C
C---- Display predicted pattern
C
C***** If there is a flush events call here, the predicted pattern atkes
C forever to put up. If there is NO flushing it goes up very fast indeed.
C*****
C CALL XDLF_FLUSH_EVENTS(I)
CALL MXDDVN(BOX_VEC)
CALL DSPPRD(NDISP,MODE)
C
C---- Display residual vectors
C
IF (LPINTG.AND.(MODE.EQ.5)) THEN
CALL DSPRSD
CALL DSPBAD
END IF
C
NZOOM = 0
CIRCLES = .FALSE.
CALL XDLF_FLUSH_EVENTS(I)
AUTOIND = .FALSE.
C
C------------------------------------------------------------
c
c Start poll loop
8 IF (LPAUSE) THEN
CALL MXDBSY(1,'Waiting for input with timeout set')
ELSE
CALL MXDBSY(1,'Waiting for input')
END IF
C
C
10 IVHLIST(1) = IVHMEN
IVHLIST(2) = IVHPAR
IVHLIST(3) = IVHIMG
IVHLIST2(1) = IVHMEN
IVHLIST2(2) = IVHPAR
IVHLIST2(3) = IVHIMG
IF (JDSPWD .GT. 0) THEN
NUMVH = 3
ELSE
NUMVH = 2
ENDIF
C
MSECS = WTIME*1000
IF (MSECS.LE.0) MSECS = 1
NUMVH2 = NUMVH
IF (LPAUSE) THEN
CALL XDLF_GET_EVENTS_TIMEOUT(NUMVH,IVHLIST,MSECS,
+ NUMVH2,IVHLIST2,IVH)
IF (IVH.EQ.-1) THEN
CALL MXDBSY(-1, ' ')
CALL MXDBSY2(-1, ' ',' ')
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Do not allow timeout in POWDER mode
C
IF (POWDER) THEN
LPAUSE = .FALSE.
LINE = 'Timeout mode'
VALUESTR = ' '
ITOG = 2
IPAUSE = 48
I = 3
CALL MXDPVL(I, .TRUE., ITOG,LINE,
+ IPAUSE,VALUESTR,IERR)
GOTO 8
ELSE
RETURN
END IF
END IF
ELSE
CALL XDLF_GET_EVENTS(NUMVH,IVHLIST,IVH)
END IF
LPRKBC = .FALSE.
C
IF (IVH .EQ. 0) THEN
c Keyboard input present, ignore unless sub_process mode
CONTINUE
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ELSEIF(IVH .EQ. IVHMEN) THEN
CALL MXDBSY(-1, ' ')
CALL MXDBSY2(-1, ' ',' ')
C
c Menu event picked
CALL XDLF_MENU_AREA_GETITEM(IVHMEN, ITEM, IQUIT)
IF (IQUIT .GT. 0) THEN
c Quit entry picked, so close down & exit
GO TO 900
ENDIF
c
c Get root coordinates, for display message
CALL XDLF_MENU_AREA_GETROOTXY(IVHMEN,IX,IY)
C
c Now test all menu entries
C
C---- Change ITEM if working with second menu and not zoom,pick,circles
C
IF (MENU2.AND.ITEM.LE.MZOOM) ITEM = ITEM + 100
C
C---- Jump back to here if doing spot find as part of autoindexing
C
12 CONTINUE
C
C---- Menu item "Predict" (menu 1)
C
IF (ITEM .EQ. MPRD) THEN
C
C............................ Calculate and display predicted pattern
C
C
C----- Delete existing prediction
C
CALL MXDDVN(BOX_VEC)
IF (LPINTG.AND.(MODE.EQ.5)) CALL DSPBAD
C
C---- Calculate new spot list
C
IF (NEWRES.AND.(.NOT.POWDER)) THEN
IFLAGPR = 0
CALL PREDICT(PSI,IFLAGPR)
C
C---- Trap too many reflections generated
C
IF (IFLAGPR.LT.0) THEN
WRITE(LINE,FMT=6210) NREFLS
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
NEWRES = .FALSE.
END IF
C
C---- Display new pattern
C
CALL DSPPRD(NDISP,MODE)
IF (CIRCLES) THEN
IF (JDSPWD .GT. 0)
+ CALL MXDCIR(
+ NCIRC, RESCMX, DISTANCE, THETA, WAVELENGTH, RESCIR)
ENDIF
C
C---- Menu item "Clear prediction"
C
ELSEIF (ITEM .EQ. MCLEAR) THEN
CALL MXDDVN(BOX_VEC)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Menu item " Adjust"
C
ELSEIF (ITEM .EQ. MADJ) THEN
IF (MODE.NE.5) THEN
CALL DSPADJ(LHELP)
ADJUST = .TRUE.
END IF
C
C---- Menu item "Auto-refine"
C
ELSEIF (ITEM .EQ. MARF) THEN
IF (.NOT.FIRSTPACK) THEN
LINE = 'Auto-refine can ONLY be used for the '//
+ 'first image to be processed'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
IF (MODE.EQ.5) RETURN
LINE = 'The display will remain, orientation refined'//
+ ' and the image integrated'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR('Cancel'),
+ 6,3,0,IBUTTON)
IF (IBUTTON.EQ.1) THEN
MODE = 1
RETURN
ELSE
CONTINUE
END IF
C
C---- Menu item "Continue"
C
ELSEIF (ITEM .EQ. MINTG) THEN
IF (MODE.EQ.5) RETURN
IF (.NOT.LHELP) RETURN
RETURN
C
C---- Menu item "Find hkl"
C
ELSE IF (((ITEM.EQ.MINDX).AND.(.NOT.POWDER)).OR.
+ (ITEM.EQ.MFHKL)) THEN
LINDEX = .TRUE.
C
C---- Get reflection indices
C
IXM = 200
IYM = 200
LINELEN = 60
NUMLIN = 3
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
20 LINE = ' '
WRITE (LINE, 6190)
6190 FORMAT (1X,'Give indices of reflection to be found: ')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CALL MXDCIO(1,0,0,0,0)
GOTO 10
END IF
C
C---- Indices given
C
CALL MKEYNM(3,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) THEN
GOTO 20
END IF
CALL MXDCIO(1,0,0,0,0)
DO 21 I = 1,3
IF (ITYP(I).EQ.2) THEN
IHKLX(I) = VALUE(I)
ELSE
IHKLX(I) = -999
END IF
21 CONTINUE
CALL GETPIX(NDISP,IHKLX,IXP,IYP,IFLAG)
NDISPP = NDISP
C
C---- If reflection not found, give error message
C
IF (IFLAG.NE.0) THEN
LINE = 'Reflection not found in displayed area'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
ELSE
C
C---- Reflection found, draw a big blue cross.
C
IISIZE = 10
CALL DSPXCRS(IXP,IYP,1,5,IISIZE)
END IF
C
C---- Menu item "Read spots"
C
ELSE IF (ITEM.EQ.MSPOTS) THEN
C
C---- Check if in editing mode
C
IF (LSPEDIT) THEN
C
C---- Check if in active editing mode
C
IF (LKILL) THEN
C
C---- Ask if user wants to save edited list or quit
C
CALL MXDCIO(1,0,0,0,0)
CALL DSPENDEDT
C
C---- Reset all flags
C
LSPEDIT = .FALSE.
LKILL = .FALSE.
MENU_ITEMS(MSPOTS) = 'Read spot list'
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
ELSE
C
C---- Put up message
C
CALL DSPEDT(LHELP)
MENU_ITEMS(MSPOTS) = 'End edit'
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
LKILL = .TRUE.
END IF
ELSE
C
C---- Not yet in spots drawing/editing mode
C
MENU_ITEMS(MSPOTS) = 'Edit spot list'
LSPEDIT = .TRUE.
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
C
C---- Read and store spot coordinates from file
C
CALL RDSPOT(IFLAG)
IF (IFLAG.EQ.0) THEN
C
C---- Display spots
C
MODEDISP = 0
CALL DSPSPT(MODEDISP)
ELSE
LSPEDIT = .FALSE.
END IF
END IF
C
C---- Menu item "Bad spots"
C
ELSE IF (ITEM.EQ.MBADSP) THEN
C
C---- Check if in active editing mode
C
IF (LBADSP) THEN
MENU_ITEMS(MBADSP) = 'Bad spots'
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
LBADSP = .FALSE.
CALL MXDCIO(1,0,0,0,0)
ELSE
MENU_ITEMS(MBADSP) = 'End spot edit'
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
LBADSP = .TRUE.
IXM = 200
IYM = 200
LINELEN = 75
NUMLIN = 20
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = ' '
LINE = 'Bad spots are indicated by a red cross.'
CALL MXDWIO(LINE,2)
LINE = ' '
LINE = 'Click the mouse on a spot to change its status.'
CALL MXDWIO(LINE,2)
LINE = ' '
LINE = 'ie a "Bad spot" will be accepted, an accepted'
+ //' spot will become rejected.'
CALL MXDWIO(LINE,2)
LINE = ' '
LINE = 'When finished, choose the "End spot edit" menu'
+ //' item.'
CALL MXDWIO(LINE,2)
END IF
C
C---- Menu item "Abort"
C
ELSE IF (ITEM.EQ.MABORT) THEN
IXM = 200
IYM = 200
LINELEN = 75
NUMLIN = 4
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = ' '
LINE = 'Current operation will be aborted'
CALL MXDWIO(LINE,0)
LINE = ' '
LINE = 'Do you really want to abort (Y) ?'
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
IF (STR1.EQ.'Y') THEN
MODE = 99
RETURN
ELSE
GOTO 10
END IF
C
C
C---- Menu item "Read image"
C
ELSE IF (ITEM.EQ.MREAD) THEN
C
C---- Check if in spot editing mode
C
IF (LKILL) THEN
LINE = 'Please end the spot edit first'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- Get image number or full file name
C
IXM = 200
IYM = 200
LINELEN = 100
NUMLIN = 6
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = ' '
28 IF (TEMPLATE) THEN
WRITE (LINE, 6108)
ELSE
WRITE (LINE, 6110)
END IF
6108 FORMAT (1X,'Give image number or new template ',
+ ' (C/R to exit): ')
6110 FORMAT (1X,'Give image number or full file name (C/R to exit): ')
NIMAG = NIMAG + 1
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
NIMAG = NIMAG - 1
CALL MXDCIO(1,0,0,0,0)
GOTO 10
END IF
C
IF (ITYP(1).EQ.2) THEN
C
C---- Image number given
C
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) THEN
GOTO 28
END IF
ID = NINT(VALUE(1))
C
C---- If in TEMPLATE mode, check that a new TEMPLATE has been specified
C using keyword input
C
IF (TEMPLATE) THEN
IF (LENSTR(TEMPLSTART).GT.0) THEN
WAXFNN = TEMPLSTART(1:LENSTR(TEMPLSTART))
ELSE IF (LENSTR(TEMPLEND).GT.0) THEN
WAXFNN = TEMPLEND(1:LENSTR(TEMPLEND))
ELSE
WAXFNN = 'X'
END IF
C
C---- If last character of WAXFNN is a "." then remove it.
C
I = LENSTR(WAXFNN)
IF (I.GT.1) THEN
IF (WAXFNN(I:I).EQ.'.') WAXFNN(I:I) = ' '
END IF
IF (WAXFNN.NE.WAXFN) THEN
WAXFN = WAXFNN
CALL IMGMAKE(NTDIG,ID,IMGNUM)
SPTNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.spt'
IF (INEWMAT.NE.2)
+ NEWMATNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.mat'
END IF
END IF
ELSE IF (ITYP(1).EQ.1) THEN
C
C---- String given, can be TEMPLATE or filename
C
IF (TEMPLATE) THEN
CALL TEMPLREAD(LINE2(IBEG(1) :IEND(1)),TEMPLSTART,
+ TEMPLEND,NTDIG)
IF (NTDIG.EQ.0) THEN
WRITE(IOUT,FMT=6111) STR2(1:LENSTR(STR2))
IF (ONLINE) WRITE(ITOUT,FMT=6111)
+ STR2(1:LENSTR(STR2))
6111 FORMAT(1X,'***** ERROR *****',/,1X,
$ 'The supplied template',
+ ' (',A,')',/,1X,'does not have the corr',
$ 'ect format. It must be of the form ',
$ '"string1"###"string2" ',/,1X,'where ',
$ 'the number of # symbols matches the nu',
$ 'mber of digits.')
WRITE(IOLINE,FMT=6111) STR2(1:LENSTR(STR2))
CALL WINDIO(NULINE)
GOTO 28
END IF
C
C---- Now get image number
C
29 WRITE (LINE, 6112)
6112 FORMAT (1X,'Give image number (C/R to exit): ')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CALL MXDCIO(1,0,0,0,0)
GOTO 10
END IF
C
IF (ITYP(1).EQ.2) THEN
C
C---- Image number given
C
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) THEN
GOTO 29
END IF
ID = NINT(VALUE(1))
ELSE
GOTO 29
END IF
ELSE
C
C---- Image filename given, need to break it down
C
WAXFN = LINE2(IBEG(1) :IEND(1))
NCH = LENSTR(WAXFN)
NCH2 = NCH
C
C---- Extract directory (if any) and reset WAXFN to string stripped of
C the directory
C
DO 30 I = NCH,1,-1
IF ((WAXFN(I:I).EQ.'/').OR.
+ (WAXFN(I:I).EQ.']')) THEN
FDISK(1) = WAXFN(1:I)
TEMPCH = WAXFN
WAXFN = ' '
WAXFN = TEMPCH(I+1:NCH)
NCH2 = LENSTR(WAXFN)
GOTO 32
END IF
30 CONTINUE
C
C---- Check if extension has been given, if so transfer it to ODEXT
C and reset WAXFN to filename excluding extension
C
32 NCH = NCH2
DO 34 I = NCH,1,-1
IF (WAXFN(I:I).EQ.'.') THEN
ODEXT = ' '
ODEXT = WAXFN(I+1:NCH)
TEMPCH = WAXFN
WAXFN = ' '
WAXFN = TEMPCH(1:I-1)
IMGFN = WAXFN
J = I
GOTO 36
END IF
34 CONTINUE
J = NCH
C
C---- Extract image template, assuming filename of form ABCD_00N.ext and
C searching for _, then set WAXFN to filename stripped of number 00N
C
36 DO 38 I = J,1,-1
IF (WAXFN(I:I).EQ.SEPCHAR) THEN
C
C---- Get the image number as a string
C
IMGNUM = WAXFN(I+1:J-1)
TEMPCH = WAXFN
WAXFN = TEMPCH(1:I-1)
IMGTEMPL = WAXFN(1:I-1)
IDENT = WAXFN
GOTO 40
END IF
38 CONTINUE
C
C---- Does not have separator...illegal filename type
C
WRITE(IOUT,FMT=6290) WAXFN(1:LENSTR(WAXFN))
IF (ONLINE) WRITE(ITOUT,FMT=6290)
+ WAXFN(1:LENSTR(WAXFN))
6290 FORMAT(/,1X,'Illegal filename: ',A,/,1X,
+ 'If not of standard type (abcd_123.img) then',
+ ' use the TEMPLATE keyword.')
WRITE(IOLINE,FMT=6290) WAXFN(1:LENSTR(WAXFN))
CALL WINDIO(NULINE)
GOTO 28
C
C---- Extract image number as a value from the string
C
C ******************************************
40 CALL MPARSE(IMGNUM,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
CALL MKEYNM(1,1,IMGNUM,IBEG,IEND,ITYP,NTOK)
C *******************************************
C---- Trap error in number
C
IF (IOERR) THEN
GOTO 28
END IF
ID = NINT(VALUE(1))
C
C---- Set up new default filename for spots file and matrix. INEWMAT=2
C if a NEWMAT keyword has been given. Note it is set to 1 by "TOREFIX"
C so that once autoindexing has been called it will not be reset to 2.
C
NCH = LENSTR(WAXFN)
IF (NCH.GT.0) THEN
SPTNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.spt'
IF (INEWMAT.NE.2)
+ NEWMATNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.mat'
END IF
C
C---- END OF "IMAGE FILE NAME GIVEN"
C
END IF
ENDIF
C
NOIMG(NIMAG) = ID
IDPACK(NIMAG) = ID
C
C---- Close existing file
C
CAL IF (.NOT.PACK) CALL QCLOSE(INOD)
C
MODEOP = 1
C
C---- Set IPACK to zero so that arrays PHIBEGA, PHIENDA are not set up.
C
IPACK = 0
OHDIST = HDIST
C ********************************************************
CALL OPENODS(WAXFN,ID,NFIRSTI,ODEXT,FDISK,MODEOP,
+ PACK,ODFILE,SEPCHAR,FORCEREAD,IPACK,
+ TEMPLSTART,TEMPLEND)
C *******************************************************
C
C---- Trap image does not exist
C
IF (ID.LE.-999) THEN
NIMAG = NIMAG - 1
LINE = ' '
IF (ID.EQ.-999) THEN
WRITE(LINE,6021)
6021 FORMAT(1X,'Image does not exist, try again')
ELSE IF (ID.EQ.-1001) THEN
WRITE(LINE,6390)
6390 FORMAT(1X,'Image exists, but is wrong size (not',
+ ' finished ?), try again')
ELSE IF (ID.EQ.-1002) THEN
WRITE(LINE,6392)
6392 FORMAT(1X,'Error decoding image header, see ',
+ 'terminal window for details.')
END IF
CALL MXDWIO(LINE, 1)
GOTO 28
END IF
C
C---- Get phi values for this pack
C
IF (SAVED) THEN
ISTRT = ISTRTSV
IANGLE = IANGLESV
SAVED = .FALSE.
END IF
C
PHIRNG = PHIEND - PHIBEG
IF (NIMAG.GT.1) THEN
CAL PHIBEG = PHIBEG + (ID - IDPACK(NIMAG-1))*PHIRNG
PHIBEG = PHIBEG + (ID - NOIMG(NIMAG-1))*PHIRNG
PHIEND = PHIBEG + PHIRNG
PHI(NIMAG) = 0.5*(PHIBEG+PHIEND)
PHISTIM(NIMAG) = PHIBEG
END IF
C
C---- Reassign image numbner to start with after an abort
C
IRSTRT = NIMAG
C
C---- If phi values from the header are to be used, set these up
C Similarly for distance and wavelength
C
IF (HEADINFO.AND.(IANGLE.EQ.0)) THEN
PHIBEG = HPHIS
PHIEND = HPHIE
PHIRNG = PHIEND - PHIBEG
PHI(NIMAG) = 0.5*(PHIBEG+PHIEND)
PHISTIM(NIMAG) = PHIBEG
END IF
RESTID = ID
RESTIDENT = WAXFN
RESTPHIB = PHIBEG
RESTPHIE = PHIEND
C
C---- If using distance from header, set this up too
C IDIST = 0 if not set at all
C = 2 if set with keyword
C = 1 if obtained from header or parameter window
C
IF (HEADINFO) THEN
X = 100.0*HDIST
IF (IDIST.NE.2) THEN
IF (ABS(X-XTOFD).GT.0.1) THEN
WRITE(IOUT,FMT=6400) 0.01*XTOFD, 0.01*X
IF (ONLINE) WRITE(ITOUT,FMT=6400)0.01*XTOFD,0.01*X
WRITE(LINE,FMT=6400) 0.01*XTOFD, 0.01*X
6400 FORMAT(1X,'Warning, distance from header updated ',
+ 'from',F8.2,' to',F8.2,'mm.')
CALL MXDWIO(LINE, 1)
END IF
XTOFD = X
C
C---- Update parameter table for new distance
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
ELSE
IF (ABS(OHDIST-HDIST).GT.0.1) THEN
WRITE(LINE,FMT=6410) HDIST
WRITE(IOUT,FMT=6410) HDIST
IF (ONLINE) WRITE(ITOUT,FMT=6410) HDIST
6410 FORMAT(1X,'** Warning, distance in header has',
+ ' changed, now',F8.2,'mm. **')
CALL MXDWIO(LINE, 1)
END IF
END IF
END IF
C
C---- Get confirmation of these phi values
C
41 IF (HEADINFO.AND.(IANGLE.EQ.0)) THEN
WRITE(LINE,6022) PHIBEG,PHIEND
ELSE
WRITE(LINE,6020) PHIBEG,PHIEND
END IF
6020 FORMAT(1X,'Start and end phi values (',F8.2,',',
+ F8.2,') :')
6022 FORMAT(1X,'Start and end phi values from header (',F8.2,',',
+ F8.2,') :')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(2,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 41
PHIBEG = VALUE(1)
PHIEND = VALUE(2)
PHI(NIMAG) = 0.5*(PHIBEG+PHIEND)
PHISTIM(NIMAG) = PHIBEG
END IF
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
C
C---- Set IMGHI=IMGLOW=0 to force scaling
C
IMGHI = 0
IMGLOW = 0
CALL DSPIMG(IMAGE(ISTART*IYLEN+1),NREC,IYLEN,NEWSCL,
+ STORIMAG)
PREDICTED = .FALSE.
CAL Try setting NSPT to zero here
NSPT = 0
NSPTD = 0
NZOOM = 0
IZOOM = 0
C
C---- Set number of predicted spots to zero
C
TOSPT = 0
NSPOT = 0
C
C---- Display RMIN circle (backstop shadow)
C
ICOLR = 1
IF ((RMINX.NE.0.0).AND.(RMINY.NE.0.0)) THEN
RX = 0.01*RMINX
RY = 0.01*RMINY
ELSE
RX = 0.01*XCEN
RY = 0.01*YCEN
END IF
CALL MXDDVN(CIRC_VEC)
CALL DSPCIRC(RX,RY,0.01*RMIN,ICOLR)
C
C---- Display spot list or predicted pattern
C
IF (NDISP.GT.0) CALL DSPPRD(NDISP,MODE)
C
IF (LDISPSPT) THEN
IF (POWDER) THEN
MENU_ITEMS2(MCLRSPT-100) = 'Clear spots'
LDISPSPT = .FALSE.
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
END IF
END IF
C
C---- If spots cleared from previous, reset menu
C
IIMAG = IIMAG + 1
IF (LPAUSE) THEN
CALL MXDBSY(1,'Waiting for input with timeout set')
ELSE
CALL MXDBSY(1,'Waiting for input')
END IF
C
C---- Menu item "Find spots"
C
ELSE IF (ITEM.EQ.MFIND) THEN
C
C---- Check if in spot editing mode
C
IF (LKILL) THEN
LINE = 'Please end the spot edit first'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- Check if ading spots manually
C
IF (ADDSPOTS) THEN
MENU_ITEMS2(MFIND-100) = 'Find spots'
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ADDSPOTS = .FALSE.
CALL MXDCIO(1,0,0,0,0)
BOXOPEN2 = .FALSE.
C
C---- If this was called as part of autoindexing, save spots and then
C jump out
C
IF (AUTOIND) THEN
CALL MENSAVE(AUTOIND,NEWSPOTS)
ITEM = MAUTO
GOTO 12
END IF
GOTO 10
END IF
C
C---- Check if direct beam coords have been supplied
C
IF (IBEAM.EQ.0) THEN
IXM = 200
IYM = 200
LINELEN = 80
NUMLIN = 6
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
C
WRITE(IOLINE,FMT=6270)
C
CALL WINDIO(NULINE)
CALL MXDRIO(LINE)
CALL MXDCIO(1,0,0,0,0)
IBEAM = 1
GOTO 10
END IF
C
C---- Finding spots for autoindexing.
C
C---- First check that phi values have been given for this image
C
!
! We want to ask the user if they want to use the new-style peak-picking
! every time
!
C
C Create IO window
C
CHRP the next bit is ready for new-style peak searching
CHRP
CHRP IXM = 200
CHRP IYM = 200
CHRP LINELEN = 100
CHRP NUMLIN = 5
CHRP IXM = 400
CHRP IYM = 400
CHRP CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
CHRP 6328 FORMAT(1X,
CHRP $ 'Do you want to try the new-style peak picking? (Y): ')
CHRP 152 WRITE(LINE,6328)
CHRP CALL MXDWIO(LINE, 1)
CHRP CALL MXDRIO(LINE2)
C ******************************************
CHRP CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
CHRP IF (NTOK.EQ.0) THEN
CHRP STR1 = 'Y'
CHRP ELSE
CHRP STR1 = LINE2(IBEG(1):IEND(1))
CHRP CALL CCPUPC(STR1)
CHRP ENDIF
CHRP IF (STR1.NE.'Y') THEN
CHRP 6330 FORMAT('Using OLD-STYLE peak search')
CHRP WRITE(LINE,FMT=6330)
CHRP CALL MXDWIO(LINE,2)
CHRP DPS_SEARCH = .FALSE.
CHRP ELSE
CHRP DPS_SEARCH = .TRUE.
CHRP ENDIF
CHRP IF (IOERR) GOTO 152
!
! Back to old-style input
!
PHIRNG = PHIEND - PHIBEG
IF (PHIRNG.LE.0.0) THEN
C
IXM = 200
IYM = 200
LINELEN = 100
NUMLIN = 2
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
IXM = 400
IYM = 400
43 WRITE(LINE,6023)
6023 FORMAT(1X,'Start and end phi values ? :')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
GOTO 43
ELSE
CALL MKEYNM(2,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 43
PHIBEG = VALUE(1)
PHIEND = VALUE(2)
PHI(NIMAG) = 0.5*(PHIBEG+PHIEND)
PHISTIM(NIMAG) = PHIBEG
PHIRNG = PHIEND - PHIBEG
END IF
CALL MXDCIO(1,0,0,0,0)
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
END IF
C
C
C---- Check for an offset detector, and if necessary, change the direction
C that the background strip is measured in so that it does not extend
C beyond the edge of the detector.
C
IF ((ABS(XCEN*0.01-NREC*RAST*0.5).GT.0.045*NREC*RAST).AND.
+ (ROTATED)) THEN
RMINSP = SIGN(RMINSP,(NREC*RAST*0.5-XCEN*0.01))
RMAXSP = SIGN(RMAXSP,(NREC*RAST*0.5-XCEN*0.01))
END IF
IF ((ABS(YCEN*0.01-IYLEN*RAST*0.5).GT.0.045*IYLEN*RAST).AND.
+ (.NOT.ROTATED)) THEN
RMINSP = SIGN(RMINSP,(IYLEN*RAST*0.5-YCEN*0.01))
RMAXSP = SIGN(RMAXSP,(IYLEN*RAST*0.5-YCEN*0.01))
END IF
C
C---- Check that with the current beam centre and RMAXSP the search will
C not go outside the scanned area.
C For swung out Raxis detectors search on opposite side of beam
C because background will be higher at small radius (water ring is
C closer to beamstop).
C *** NO LONGER NEEDED BECAUSE OF ABOVE TEST ***
CAL IF ((MACHINE(1:4).EQ.'RAXI').AND.(TWOTHETA.GT.0)) THEN
CAL RMINSP = -RMINSP
CAL RMAXSP = -RMAXSP
CAL END IF
IXCEN = 0.01*XCEN/RAST
IYCEN = 0.01*YCEN/RAST
IRMIN = NINT(RMINSP/RAST)
IRMAX = NINT(RMAXSP/RAST)
CHRMIN = .FALSE.
CHRMAX = .FALSE.
C
C---- Get cleverer here, automatically reset rmin or rmax if they
C extend beyond the image edge. Remember than rminsp,rmaxsp can
C be negative
C
IF (RADX) THEN
IF (IXCEN+IRMIN.LT.1) THEN
IRMIN = 2 - IXCEN
CHRMIN = .TRUE.
ELSE IF (IXCEN+IRMIN.GT.NREC) THEN
IRMIN = NREC - IXCEN -1
CHRMIN = .TRUE.
END IF
IF (IXCEN+IRMAX.LT.1) THEN
IRMAX = 2 - IXCEN
CHRMAX = .TRUE.
ELSE IF (IXCEN+IRMAX.GT.NREC) THEN
IRMAX = NREC - IXCEN -1
END IF
END IF
IF (RADY) THEN
IF (IYCEN+IRMIN.LT.1) THEN
IRMIN = 2 - IYCEN
CHRMIN = .TRUE.
ELSE IF (IYCEN+IRMIN.GT.NREC) THEN
IRMIN = NREC - IYCEN -1
CHRMIN = .TRUE.
END IF
IF (IYCEN+IRMAX.LT.1) THEN
IRMAX = 2 - IYCEN
CHRMAX = .TRUE.
ELSE IF (IYCEN+IRMAX.GT.NREC) THEN
IRMAX = NREC - IYCEN -1
CHRMAX = .TRUE.
END IF
END IF
RMINSP = RAST*IRMIN
RMAXSP = RAST*IRMAX
IF (CHRMIN.OR.CHRMAX) THEN
IF (CHRMIN) THEN
STR3 = 'Rmin'
ELSE
STR3 = 'Rmax'
END IF
LINE = STR3//' has been changed to avoid going'//
+ ' outside scanned area'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,
+ XDLSTR(' '),-1,3,0,IBUTTON)
C
C---- Update parameter table for new threshold
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
END IF
C
C---- If no spots displayed for this image, force ab initio spot find
C
IF (NSPTD.EQ.0) MODESP = 0
C
C---- Display radial background box
C
IF (MODESP.EQ.0) THEN
CALL DSPBGD
C
C---- Give information
C
IF (LHELP) THEN
C
C---- DSPFND creates i/o window ONLY IF LHELP true, but does NOT close it
C
CALL DSPFND(LHELP,LINE,BOXOPEN2)
C
C---- Parse reply to "Do you wish to continue" set up by DSPFND
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
ELSE
STR1 = 'Y'
END IF
ELSE
STR1 = 'Y'
END IF
C
IF (STR1.EQ.'Y') THEN
C
C---- Delete any existing spot display and vector list
C
SELECT(NIMAG) = .TRUE.
SPOTFND(NIMAG) = .TRUE.
C
C---- See if spots are to be added
C manually
C
IF (.NOT.BOXOPEN2) THEN
C
C Create IO window
C
IXM = 200
IYM = 200
LINELEN = 56
NUMLIN = 12
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
BOXOPEN2 = .TRUE.
END IF
LINE = 'Do you want to find spots manually ? (N)'
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') GOTO 160
C
C---- Delete overlay symbols
C
CALL MXDDSY
C
C---- Delete overlay vectors
C
CALL MXDDVC
C
C----- Redraw backstop circle
C
ICOLR = 1
IF ((RMINX.NE.0.0).AND.(RMINY.NE.0.0)) THEN
RX = 0.01*RMINX
RY = 0.01*RMINY
ELSE
RX = 0.01*XCEN
RY = 0.01*YCEN
END IF
CALL DSPCIRC(RX,RY,0.01*RMIN,ICOLR)
UPDATE = .FALSE.
IF (ITHSET.EQ.0) THEN
MODESP = 10
UPDATE = .TRUE.
END IF
C
C
C---- If minimum spot separation not set, get a value now as it helps
C discriminate good spots from bad.
C
IF (ISEP.EQ.0) THEN
MODEGSR = 1
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
END IF
C
C---- Do spot search. Note that PICKSPOTS, called from GETSPOTS,
C writes to the I/O window and closes it.
C
CALL MXDBSY(0,'Finding spots')
44 CONTINUE
CHRP
CHRP the following should be removed unless we put in a new peak search
CHRP IF (DPS_SEARCH) THEN
CHRP CALL DPSSEARCH(XMM,YMM,NSPOT,IERRFLG)
CHRP IF (IERRFLG .ne. 0)THEN
CHRP IERRFLG = 0
! close popup window
CHRP CALL MXDCIO(1,0,0,0,0)
CHRP CALL XDLF_FLUSH_EVENTS(I)
!
! return to top of MXDSPL menu
!
CHRP GOTO 10
CHRP ENDIF
CHRP ELSE
CALL GETSPOTS(MODESP,IDPACK(NIMAG),LPRNT,BOXOPEN2,IERR)
CHRP ENDIF
C
C---- Trap error in background determination
C
IF (IERR.GT.0) THEN
RAD = IERR*RAST
WRITE(LINE,6024) RAD
6024 FORMAT(1X,'Too few pixels with non-zero values at',
+ ' radius',F6.1,'mm, change Rmin or Rmax')
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
SPOTFND(NIMAG) = .FALSE.
GOTO 10
ELSE IF (IERR.EQ.-1) THEN
LINE = 'No spots found'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
SPOTFND(NIMAG) = .FALSE.
GOTO 10
C
C---- Trap too many spots found (threshold too low)
C
ELSE IF (IERR.EQ.-2) THEN
STHRESH = THRESH
THRESH = MAX(1.0,(THRESH + 0.5*THRESH))
IF (THRESH.LT.1000) THEN
WRITE(IOUT,FMT=6025) THRESH
IF (ONLINE) WRITE(ITOUT,FMT=6025) THRESH
WRITE(LINE,FMT=6025) THRESH
6025 FORMAT(1X,'Too many spots found, threshold ',
+ 'increased to',F8.1)
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR('Abort'),
+ 5,3,0,IBUTTON)
IF (IBUTTON.EQ.1)THEN
C
C---- Update parameter table for new threshold
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
GOTO 44
ELSE
CALL MXDCIO(1,0,0,0,0)
BOXOPEN2 = .FALSE.
THRESH = STHRESH
GOTO 10
ENDIF
ELSE
SPOTFND(NIMAG) = .FALSE.
GOTO 10
END IF
C
C---- Trap too many spots found to store (max is NSPOTS)
C
ELSE IF (IERR.EQ.-3) THEN
WRITE(IOUT,FMT=6026) NSPOTS
IF (ONLINE) WRITE(ITOUT,FMT=6026) NSPOTS
6026 FORMAT('The total number of spots found is too ',
+ 'large (maximum ',I5,').',/,1X,'Either increase the',
+ ' spot search threshold, or change parameter NSPOTS',
+ /,1X,'and recompile program.')
WRITE(LINE,FMT=6027) NSPOTS
6027 FORMAT('Too many spots to store (max',I5,')',
+ ' increase threshold')
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
ELSE
C
C---- No errors
C
IF (UPDATE) THEN
C
C---- Update parameter table for new threshold
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
UPDATE = .FALSE.
END IF
END IF
NEWSPOTS = .TRUE.
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Give option to add spots manually
C
LINE = 'Do you want to add spots manually ? (N)'
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
160 IF (STR1.EQ.'Y') THEN
LINE = 'Add spots by clicking on them with the mouse'
CALL MXDWIO(LINE,1)
LINE ='All added spots will have an I/sig(I) of 1000'
CALL MXDWIO(LINE,1)
LINE = 'To finish, select "End add spots" in menu'
CALL MXDWIO(LINE,1)
LINE = ' '
IF (MEDWXSPOT.EQ.0) MEDWXSPOT = 5
IF (MEDWYSPOT.EQ.0) MEDWYSPOT = 5
WRITE(LINE,FMT=6340) MEDWXSPOT,MEDWYSPOT
6340 FORMAT('Change the spot size (',I2,' by',
+ I2,' pixels) (N) ?')
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
154 IF (STR1.EQ.'Y') THEN
LINE = 'Give new spot size: '
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
GOTO 154
ELSE
CALL MKEYNM(2,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 154
MEDWXSPOT = VALUE(1)
MEDWYSPOT = VALUE(2)
END IF
END IF
LINE = 'Select spots with mouse'
CALL MXDWIO(LINE,1)
MENU_ITEMS2(MFIND-100) = 'End add spots'
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ADDSPOTS = .TRUE.
CAL LSPEDIT = .TRUE.
CAL MODEDISP = 0
CAL CALL DSPSPT(MODEDISP)
ELSE
C
C---- Close I/O window
C
CALL MXDCIO(1,0,0,0,0)
BOXOPEN2 = .FALSE.
END IF
ELSE
C
C---- If "N" given is response to query to continue
C Close window (if opened)
C
IF (LHELP) CALL MXDCIO(1,0,0,0,0)
BOXOPEN2 = .FALSE.
CALL MXDDVC
C
C----- Redraw backstop circle
C
ICOLR = 1
IF ((RMINX.NE.0.0).AND.(RMINY.NE.0.0)) THEN
RX = 0.01*RMINX
RY = 0.01*RMINY
ELSE
RX = 0.01*XCEN
RY = 0.01*YCEN
END IF
CALL DSPCIRC(RX,RY,0.01*RMIN,ICOLR)
GOTO 10
END IF
CALL MXDBSY(-1, ' ')
CALL MXDBSY2(-1,' ',' ')
C
C---- If this was called as part of autoindexing, save spots and then
C jump out
C
IF (AUTOIND.AND.(.NOT.ADDSPOTS)) THEN
CALL MENSAVE(AUTOIND,NEWSPOTS)
ITEM = MAUTO
GOTO 12
END IF
C
C
C---- Menu item "Edit spots"
C
ELSE IF (ITEM.EQ.MEDIT) THEN
C
C---- Check there are spots to edit !
C
IF (NSPTD.LE.0) THEN
LINE = 'There are no spots to edit !'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- Check if in active editing mode
C
IF (LKILL) THEN
C
C---- Ask if user wants to save edited list or quit
C
CALL MXDCIO(1,0,0,0,0)
CAL CALL DSPENDEDT
C
C---- Reset all flags
C
LSPEDIT = .FALSE.
LKILL = .FALSE.
MENU_ITEMS2(MEDIT-100) = 'Edit spots'
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
C
C---- Put up message
C
CALL DSPEDT(LHELP)
MENU_ITEMS2(MEDIT-100) = 'End edit'
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
LKILL = .TRUE.
END IF
CONTINUE
C
C---- Menu item "Save spots"
C
C code was for SAVE SPOTS, now considered defunct.
C
C---- Check if in spot editing mode
C
C IF (LKILL) THEN
C LINE = 'Please end the spot edit first'
C L = LENSTR(LINE)
C IXP = 400
C IYP = 400
C CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
C + XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
C + -1,3,0,IBUTTON)
C GOTO 10
C END IF
C
C
C AUTOIND = .FALSE.
C CALL MENSAVE(AUTOIND,NEWSPOTS)
C
C
C---- Menu item "Clear spots"
C
ELSE IF (ITEM.EQ.MCLRSPT) THEN
C
C---- If spots already cleared, and this is to redisplay them, do so
C
IF (LDISPSPT) THEN
MENU_ITEMS2(MCLRSPT-100) = 'Clear spots'
LDISPSPT = .TRUE.
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
MODEDISP = 0
CALL DSPSPT(MODEDISP)
LDISPSPT = .FALSE.
GOTO 10
END IF
C
C---- Allow for choice of just clearing spots from the display, or
C deleting them from the list of stored spots
C
IXM = 200
IYM = 200
LINELEN = 75
NUMLIN = 3
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
C---- Do you want to
C
LINE = ' '
WRITE(LINE,FMT=6260)
6260 FORMAT('Do you want simply want to remove spots',
+ ' from the display (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
C
C---- delete existing displayed spots
C
CALL MXDDSY
CALL MXDCIO(1,0,0,0,0)
MENU_ITEMS2(MCLRSPT-100) = 'Display spots'
LDISPSPT = .TRUE.
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
GOTO 10
ELSE
LINE = ' '
WRITE(LINE,FMT=6262)
6262 FORMAT('Do you want to delete all stored spots (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
C
C---- Reset NIMAG to 1 and set ID, PHI etc to current image
C
DO 46 I = 1,MAXIMG
SELECT(I) = .FALSE.
SPOTFND(I) = .FALSE.
46 CONTINUE
NOIMG(1) = NOIMG(NIMAG)
IDPACK(1) = IDPACK(NIMAG)
PHI(1) = PHI(NIMAG)
PHISTIM(1) = PHISTIM(NIMAG)
DO 48 I = 1,NIMAG
ISTIMG(I) = 0
IENDIMG(I) = 0
48 CONTINUE
NIMAG = 1
IRSTRT = 1
C
C---- delete existing displayed spots
C
CALL MXDDSY
END IF
CALL MXDCIO(1,0,0,0,0)
END IF
C
C---- Menu item "Select images"
C
ELSE IF (ITEM.EQ.MSEL) THEN
C
C---- Check if in spot editing mode
C
IF (LKILL) THEN
LINE = 'Please end the spot edit first'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
50 CALL DSPSEL(LINE,NPROC)
C
C
C---- Decode LINE to get slot numbers
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
CALL MKEYNM(NTOK,1,LINE,IBEG,IEND,ITYP,NTOK)
C
IF (NTOK.EQ.0) THEN
JFIRST = -1000
DO 51 I = 1,NIMAG
IF (SPOTFND(I)) THEN
SELECT(I) = .TRUE.
IF (JFIRST.LT.0) JFIRST = I
END IF
51 CONTINUE
ELSE
DO 53 I = 1,NIMAG
SELECT(I) = .FALSE.
53 CONTINUE
C
C---- Select images
C
DO 52 I = 1,NTOK
J = NINT(VALUE(I))
IF ((J.GT.0).AND.(J.LE.NIMAG)) THEN
SELECT(J) = .TRUE.
IF (I.EQ.1) JFIRST = J
GOTO 52
END IF
C
C---- No such slot
C
WRITE(LINE,6030) J
6030 FORMAT(1X,'There is no slot number', I5)
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('Repeat selection'),16,
+ XDLSTR('Abort'),5,3,0,IBUTTON)
IF (IBUTTON.EQ.1) THEN
GOTO 50
ELSE
GOTO 10
END IF
52 CONTINUE
END IF
NEWSPOTS = .TRUE.
C
C---- Change default spot and matrix filenames to reflect the image number
C of the first image to be selected.
C
IF (JFIRST.GE.0) THEN
IF (TEMPLATE) THEN
IF (NTDIG.EQ.1) THEN
WRITE(IMGNUM,FMT=6311) NOIMG(JFIRST)
6311 FORMAT(I1.1)
ELSE IF (NTDIG.EQ.2) THEN
WRITE(IMGNUM,FMT=6312) NOIMG(JFIRST)
6312 FORMAT(I2.2)
ELSE IF (NTDIG.EQ.3) THEN
WRITE(IMGNUM,FMT=6313) NOIMG(JFIRST)
6313 FORMAT(I3.3)
ELSE IF (NTDIG.EQ.4) THEN
WRITE(IMGNUM,FMT=6314) NOIMG(JFIRST)
6314 FORMAT(I4.4)
ELSE IF (NTDIG.EQ.5) THEN
WRITE(IMGNUM,FMT=6315) NOIMG(JFIRST)
6315 FORMAT(I5.5)
ELSE IF (NTDIG.EQ.6) THEN
WRITE(IMGNUM,FMT=6316) NOIMG(JFIRST)
6316 FORMAT(I6.6)
ELSE IF (NTDIG.EQ.7) THEN
WRITE(IMGNUM,FMT=6317) NOIMG(JFIRST)
6317 FORMAT(I7.7)
ELSE IF (NTDIG.EQ.8) THEN
WRITE(IMGNUM,FMT=6318) NOIMG(JFIRST)
6318 FORMAT(I8.8)
ELSE IF (NTDIG.EQ.9) THEN
WRITE(IMGNUM,FMT=6319) NOIMG(JFIRST)
6319 FORMAT(I9.9)
END IF
ELSE
WRITE(IMGNUM,FMT=6031) NOIMG(JFIRST)
6031 FORMAT(I3.3)
END IF
C
NCH = LENSTR(WAXFN)
IF (NCH.GT.0) THEN
SPTNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.spt'
IF (INEWMAT.NE.2)
+ NEWMATNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.mat'
END IF
END IF
C
C
C---- Menu item "Autoindex"
C
ELSE IF (ITEM.EQ.MAUTO) THEN
C
C---- Check if returning after an initial spot find
C
IF (AUTOIND) THEN
AUTOIND = .FALSE.
GOTO 56
END IF
C
C---- Check if in spot editing mode
C
IF (LKILL) THEN
LINE = 'Please end the spot edit first'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- Check that distance and direct beam coordinates have been set
C
IF (IDIST.EQ.0) THEN
LINE = 'Distance not set. Use parameter window'//
+ ' or Keyword input to set it.'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
IF (IBEAM.EQ.0) THEN
IXM = 200
IYM = 200
LINELEN = 80
NUMLIN = 6
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
C---- Do you want to
C
LINE = ' '
WRITE(IOLINE,FMT=6270)
6270 FORMAT('The direct beam coordinates have not been',
+ ' specified.',/,1X,
+ 'The current values are the centre of the detector.',
+ /,1X,'Use the parameter window or keyword input',
+ ' (BEAM) if the position',/,1X,
+ 'of the beam is known.',/,1X,
+ 'Enter "return" to continue')
C
CALL WINDIO(NULINE)
CALL MXDRIO(LINE)
CALL MXDCIO(1,0,0,0,0)
IBEAM = 1
GOTO 10
END IF
C
C---- Find number of spots available for autoindexing
C
NTOT = 0
DO 55 I = 1,NIMAG
IF (.NOT.SELECT(I)) GOTO 55
NTOT = NTOT + (IENDIMG(I) - ISTIMG(I)) + 1
IF (IENDIMG(I).EQ.0) NTOT = NTOT - 1
55 CONTINUE
C
C
C---- If no spots stored at all, run "Findspots"
C
IF (NTOT.EQ.0) THEN
AUTOIND = .TRUE.
ITEM = MFIND
GOTO 12
END IF
C
C---- Save the spots file in NEW format for autoindexing
C
AUTOIND = .TRUE.
CALL MENSAVE(AUTOIND,NEWSPOTS)
AUTOIND = .FALSE.
C
C---- Start here if "Findspots" has been run
C
56 NSOL = 0
C
C---- If a spacegroup has been given, check cell has also been given
C
IF (NUMSPG.GT.0) THEN
IF (CELL(1).EQ.0.0) THEN
LINE = 'Must give cell parameters if spacegroup'//
+ ' has been given'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
CALL XDLF_FLUSH_EVENTS(I)
GOTO 10
END IF
END IF
C
C---- If HELP is on, give spacegroup
C
CAL IF (LHELP) THEN
C
C---- Get image numbers etc
C
IXM = 200
IYM = 200
LINELEN = 95
NUMLIN = 20
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
BOXOPEN = .TRUE.
C
C---- Check that the latest image to be read in has been used for spot-finding
C
IF (.NOT.SPOTFND(NIMAG)) THEN
LINE = ' '
WRITE(LINE,FMT=6029)
6029 FORMAT('!!! WARNING !!!')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6037)
6037 FORMAT('No spots have been found on the latest image')
CALL MXDWIO(LINE, 1)
C
C---- Do you want to proceed ?
C
WRITE(LINE,FMT=6035)
6035 FORMAT('Do you want to proceed (N):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.NE.'Y') THEN
CALL MXDCIO(1,0,0,0,0)
GOTO 10
END IF
END IF
LINE = ' '
WRITE(LINE,FMT=6032) NUMSPG
6032 FORMAT('Auto-indexing with spacegroup: ',I3)
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE(LINE,FMT=6033)
6033 FORMAT('(see terminal window for full output)')
CALL MXDWIO(LINE, 2)
LINE = ' '
C
C---- Get list of selected images with spots found on them
C
STR = ' '
J = 0
NSAVIMG = 0
DO 57 I = 1,NIMAG
IF (SPOTFND(I).AND.SELECT(I)) THEN
WRITE(STR2,6052) NOIMG(I)
CALL STRIPSTR(STR2,NCH)
J = LENSTR(STR)
IF (J.EQ.0) THEN
STR = STR2(1:NCH)
ELSE
STR = STR(1:J)//','//STR2(1:NCH)
END IF
J = LENSTR(STR)
NSAVIMG = NSAVIMG + 1
ISAVIMG(NSAVIMG) = NOIMG(I)
END IF
57 CONTINUE
C
IF (J.GT.0) WRITE(LINE,FMT=6034) STR(1:J)
6034 FORMAT('Autoindexing will use spots from image(s): ',A)
CALL MXDWIO(LINE, 2)
!
! Harry puts in DPS indexing from here. At the moment we don't allow the
! option of keeping a known space group - the indexing seems robust enough to
! re-index every time.
!
LINE = ' '
6320 FORMAT(
$ 'The new auto-indexing option works well with either ',
$ 'single or multiple ',/,
$ 'images, and with 100 - 750 spots: it is particularly ',
$ 'good if your cell ',/,
$ 'is very anisotropic or if you have strong diffraction.',/)
6321 FORMAT(
$ 'N.B. it tries to estimate the longest cell edge. but you ',
$ 'can override this ',/,
$ 'if you wish.')
6322 FORMAT(
$ 'Do you want to try the new auto-indexing? (Y): ')
WRITE(IOLINE,FMT=6320)
CALL WINDIO(NULINE)
WRITE(IOLINE,FMT=6321)
C CALL MXDWIO(LINE,1)
CALL WINDIO(NULINE)
WRITE(LINE,FMT=6322)
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
ENDIF
IF (STR1.NE.'Y') THEN
6324 FORMAT('Using OLD-STYLE auto-indexing (REFIX)')
WRITE(LINE,FMT=6324)
CALL MXDWIO(LINE,2)
chrp05122000 DPS_INDEX = .FALSE.
DPSINDEX = .FALSE.
GOTO 1065
ENDIF
if (dmax .lt. 0.1) dmax = 200.0
chrp05122000 DPS_INDEX = .TRUE.
DPSINDEX = .TRUE.
1065 CONTINUE
!
! finish first bit of DPS indexing...
!
LINE = ' '
C
C---- Reset space group number to zero ?
C
IF (NUMSPG.GT.0) THEN
WRITE(LINE,FMT=6036)
6036 FORMAT('Do you want to change spacegroup to 0 (N) ?:')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') NUMSPG = 0
END IF
C IF (.NOT. DPSINDEX) THEN
C
C---- Fix cell parameters ? (only if not unknown spacegroup)
C
RFIXCELL = .FALSE.
IF (NUMSPG.GT.0) THEN
WRITE(LINE,FMT=6230)
6230 FORMAT('Do you want to fix the cell (N) ?:')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') RFIXCELL = .TRUE.
END IF
C
C---- Fix crystal to detector distance ? Default is to FIX if
C cell ius being refined, or REFINE if cell is fixed.
C
IF (RFIXCELL) THEN
RFIXDIST = .FALSE.
WRITE(LINE,FMT=6232)
6232 FORMAT('Do you want to fix the detector distance',
+ ' (N) ?:')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') RFIXDIST = .TRUE.
ELSE
C
C---- Cell not fixed
C
RFIXDIST = .TRUE.
WRITE(LINE,FMT=6234)
6234 FORMAT('Do you want to fix the detector distance',
+ ' (Y) ?:')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'N') RFIXDIST = .FALSE.
END IF
C ELSE ! if we are doing DPS index!
! harry removes this so we can keep the spacegroup NUMSPG = 0
C ENDIF
C
C---- Name of output orientation matrix file
C
WRITE (BIGLINE,FMT=6220)
+ NEWMATNAM(1:LENSTR(NEWMATNAM))
6220 FORMAT('Filename for final orientation matrix',
+ ' (',A,'): ')
59 CALL MXDWIO(BIGLINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get filename using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.NE.0) THEN
NCH = IEND(1) - IBEG(1) + 1
IF (NCH.GT.70) THEN
WRITE(LINE,FMT=6135)
CALL MXDWIO(LINE, 0)
GOTO 59
END IF
NEWMATNAM = LINE2(IBEG(1):IEND(1))
END IF
C
SAVMATNAM = NEWMATNAM
C
C---- Do you want to proceed ?
C
chrp05122000 IF(.not.DPS_INDEX)THEN
IF(.not.DPSINDEX)THEN
WRITE(LINE,FMT=6038)
6038 FORMAT('Do you want to proceed (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.NE.'Y') THEN
CALL MXDCIO(1,0,0,0,0)
GOTO 10
END IF
CAL END IF
CALL XDLF_FLUSH_EVENTS(I)
CALL MXDBSY(0,'Autoindexing')
ENDIF
!
!
Cccc Harry starts here, introducing DPS autoindexing... 18-Aug-1998
!
!
!
!
!
c 140 if (dps_index) then
140 if (dpsindex) then
C
C---- Save any input space group number (if permuting cell for example)
C
NUMSAVE = NUMSPG
NSOL = 0
CALL TO_DPS_INDEX(NSOL,invertX,omegaf,rfixcell,
$ rfixdist,maxcell)
if(ierrflg.eq.2)goto 10
DPSINDEX = .TRUE.
IF (IERRFLG.EQ.1) THEN
c CALL MXDCIO(1,0,0,0,0)
c BOXOPEN = .FALSE.
IERRFLG = 0
c LINE = ' '
c LINE = 'DPS Auto-indexing has failed..see terminal'//
c + ' window'
c L = LENSTR(LINE)
c IXP = 400
c IYP = 400
c CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
c + XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
c + -1,3,0,IBUTTON)
c CALL XDLF_FLUSH_EVENTS(I)
GOTO 10
END IF
!
! we don't want to do another DPS index by accident
!
ELSE
CALL TOREFIX(NSOL,BOXOPEN,RFIXCELL,RFIXDIST)
ENDIF
CALL MXDBSY(-1,' ')
C
C---- Check for failure of autoindexing
C
IF (IERRFLG.EQ.1) THEN
CALL MXDCIO(1,0,0,0,0)
BOXOPEN = .FALSE.
IERRFLG = 0
LINE = ' '
LINE = 'Auto-indexing has failed..see terminal'//
+ ' window'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
CALL XDLF_FLUSH_EVENTS(I)
GOTO 10
END IF
C
C---- Autoindexing successful, set IMAT,ICELL to 1 so can predict
C
SAVMATSTR = 'autoindexing'
IMAT = 1
CAL why do we need this ? ICELL = 1
LSYMM = 1
C
C---- If original spacegroup unknown, get user to select one
C
IF ((NUMSPG.EQ.0).OR.DPSINDEX) THEN
JUMPBACK = .FALSE.
58 IF((NSOL.LE.0).or.(NUMSAVE.EQ.0).OR.JUMPBACK)THEN
WRITE(IOUT,FMT=6040)
C AL IF (ONLINE) WRITE(ITOUT,FMT=6040)
6040 FORMAT(/,1X,'Select a solution AND a spacegroup ',
+ 'from list above (eg 3 p42) or 0 to ',
$ 'abandon: ',$)
6045 FORMAT('Select a solution AND a spacegroup from ',
+ 'list above (eg 3 p42) or 0 to abandon',
+ ' or T to change min I/sig(I): ')
IF (ONLINE) WRITE(BIGLINE,FMT=6045)
CALL MXDWIO(BIGLINE, 1)
CALL MXDRIO(LINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
C---- Check two items given
C
IF (NTOK.LT.2) THEN
IF (NTOK.EQ.1) THEN
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,
$ IDEC,NTOK)
C ******************************************
IF (ITYP(1).EQ.2) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 58
NSOL = NINT(VALUE(1))
C
C---- Abort indexing (supplied value 0)
C
IF (NSOL.EQ.0) THEN
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
BOXOPEN = .FALSE.
IF (DPSINDEX) NUMSPG = NUMSAVE
GOTO 10
END IF
ELSE IF (ITYP(1).EQ.1) THEN
STR1 = LINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
IF (STR1.EQ.'T') THEN
WRITE(BIGLINE,FMT=6047)
6047 FORMAT('Give new min I/sig(I) :')
130 CALL MXDWIO(BIGLINE, 1)
CALL MXDRIO(LINE)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,
$ IDEC,NTOK)
C ******************************************
CALL MKEYNM(1,1,LINE,IBEG,IEND,
$ ITYP,NTOK)
IF (IOERR) GOTO 130
ITHRESH = NINT(VALUE(1))
GOTO 140
END IF
END IF
END IF
GOTO 58
END IF
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 58
NSOL = NINT(VALUE(1))
ENDIF
IF (NSOL.EQ.0) GOTO 10
IF (NSOL.GT.44) THEN
WRITE(IOUT,FMT=6043)
IF (ONLINE) WRITE(ITOUT,FMT=6043)
IF (ONLINE) WRITE(BIGLINE,FMT=6043)
6043 FORMAT(1X,'*** ERROR ***, solution number must',
+ ' be in range 1-44')
CALL MXDWIO(BIGLINE, 2)
JUMPBACK = .TRUE.
GOTO 58
END IF
C
CALL MRDSYMM(2,LINE,IBEG,IEND,ITYP,VALUE,NTOK,
+ SPGNAM,NUMSPG,PGNAME,NSYM,NSYMP,RSYM,IERR)
IF (IOERR) GOTO 58
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6041) SPGNAM
IF (ONLINE) WRITE(ITOUT,FMT=6041) SPGNAM
IF (ONLINE) WRITE(BIGLINE,FMT=6041) SPGNAM
6041 FORMAT(1X,'*** Spacegroup ',A,' not recognised ***')
CALL MXDWIO(BIGLINE, 2)
JUMPBACK = .TRUE.
GOTO 58
END IF
chrp05122000 IF (.NOT. DPS_INDEX) THEN
IF (.NOT. DPSINDEX) THEN
C
C---- Trap the case when using a rhombohedral cell
C
IF (ICRYST.EQ.8) THEN
C
C---- Impose symmetry on the cell, so refix will recognise that this
C is a rhombohedral cell a=b=c, alpha=beta=gamma
C
CALL CELLFIX(CELL)
WRITE(IOUT,FMT=6039)
IF (ONLINE) WRITE(ITOUT,FMT=6039)
6039 FORMAT(/,1X,'Running refix again with ',
+ 'rhombohedral symmetry imposed')
IF (ONLINE) WRITE(BIGLINE,FMT=6049)
6049 FORMAT('Running refix again with rhombohedral ',
+ 'symmetry imposed')
ELSE
WRITE(IOUT,FMT=6042)
IF (ONLINE) WRITE(ITOUT,FMT=6042)
IF (ONLINE) WRITE(BIGLINE,FMT=6046)
END IF
6042 FORMAT(/,1X,'Running refix again with this symme',
+ 'try imposed')
6046 FORMAT('Running refix again with this symmetry',
+ ' imposed')
CALL MXDWIO(BIGLINE, 2)
C AL CALL MXDCIO(1,0,0,0,0)
C AL CALL XDLF_FLUSH_EVENTS(I)
C
CALL TOREFIX(NSOL,BOXOPEN,RFIXCELL,RFIXDIST)
ELSE
C
C a quick call to get the right A and U matrices from TO_DPS_INDEX
C
CALL TO_DPS_INDEX(NSOL,INVERTX,OMEGAF,
$ RFIXCELL,RFIXDIST,maxcell)
DO 170 I=1,6
UMATCELL(I) = CELL(I)
170 ENDDO
C
C---- Update direct beam coordinates
C
DO 142 I = 1,MAXPAX
XCENMM(I,1) = 0.01*(XCEN-CCX)
YCENMM(I,1) = 0.01*(YCEN-CCY)
142 CONTINUE
C
XMM(1) = 0.01*(XCEN - CCX)
IF (INVERTX) XMM(1) = NREC*RAST - 0.01*(XCEN - CCX)
YMM(1) = 0.01*(YCEN - CCY)/YSCAL
C
C---- If original direct beam coords were for unswung detector (ISWUNG=0)
C because the values in the parameter window are corrected for the swing
C angle, set ISWUNG=1 now so that the correction is not applied twice.
C
C
IF ((ABS(TWOTHETA).GT.0.0).AND.(ISWUNG.EQ.0))
+ ISWUNG = 1
C
C
DO 144 I = 1,MAXPAX
XCENMMIN(I) = XMM(1)
YCENMMIN(I) = YMM(1)
144 CONTINUE
ENDIF
C
C---- Check for failure of autoindexing
C
IF (IERRFLG.EQ.1) THEN
IERRFLG = 0
LINE = 'Auto-indexing has failed..see terminal'//
+ ' window'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
CALL XDLF_FLUSH_EVENTS(I)
JUMPBACK = .TRUE.
GOTO 58
END IF
C
C---- See if want to test another solution
C
IXM = 200
IYM = 200
LINELEN = 60
NUMLIN = 4
IF (ONLINE) WRITE(BIGLINE,FMT=6048)
CALL MXDWIO(BIGLINE, 1)
CALL MXDRIO(LINE)
CALL XDLF_FLUSH_EVENTS(I)
C
WRITE(IOUT,FMT=6044)
C AL IF (ONLINE) WRITE(ITOUT,FMT=6044)
6044 FORMAT(/,1X,'Do you want to accept this solution ',
+ '(Y) :',$)
6048 FORMAT('Do you want to accept this solution ',
+ '(Y) :')
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
C
C---- Read next line
C
C ******************************************************
CAL CALL MPARSER(ITIN,IOUT,LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1(1:1).EQ.'N') THEN
I = 999
CAL CALL TOREFIX(I,BOXOPEN),RFIXCELL,RFIXDIST)
JUMPBACK = .TRUE.
GOTO 58
END IF
CALL MXDCIO(1,0,0,0,0)
BOXOPEN = .FALSE.
END IF
C
C---- Must set missets to zero after autoindexing
C
PSI(1) = 0.0
PSI(2) = 0.0
PSI(3) = 0.0
C
C---- Update output window for new delphi
C
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
C
C---- Update parameter table
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
C
GOTO 10
C
C---- Menu item "Estimate Mosaicity" from MENU2
ELSE IF (ITEM.EQ.MMOSA) THEN
C
C---- estimate mosaicity from total image intensity vs mosaicity curve
C
MOSEST = .TRUE.
CALL ESTMOS(NIMAG)
MOSEST = .FALSE.
C
C---- Update parameters (eg resolution)
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
GOTO 10
C
C---- Menu item "Predict" from MENU2
ELSE IF (ITEM.EQ.MPRED) THEN
C
C............................ Calculate and display predicted pattern
C
C---- First check we have an orientation
C
IF ((IMAT.EQ.0).AND.(IUMAT.EQ.0)) THEN
LINE = 'Cannot predict, no orientation given'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- If no AMAT has yet been calculated, do that now
C
IF (IMAT.EQ.0) THEN
ICHECK = 1
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
IMAT = 1
C
C---- Can now set IUMAT to zero, so we do not get error message about
C input I matrix being ignored from predict
C
IUMAT = 0
END IF
C
C---- Need to call CONTROL to set up detector limits etc
C
MODECTRL = 1
C
C---- If GENFILE not set, set a default value
C
IF (IGENF.EQ.0) THEN
GENFILESET = .TRUE.
GENFILE = WAXFN(1:LENSTR(WAXFN))//'.gen'
END IF
C
C---- If no raster parameters given, set up values based on median
C spot size in centre of image. Need to do this here so that the
C new parameters are stored as part of the input
C
IF ((IRAST.EQ.0).OR.(ISEP.EQ.0)) THEN
NEWRAST = (IRAST.EQ.0)
NEWSEP = (ISEP.EQ.0)
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWRAST = .FALSE.
NEWSEP = .FALSE.
GOTO 10
END IF
END IF
C
C---- Set NEWGENF FALSE so it does not CALL START IN CONTROL
C (which opens a generate file and checks raster box)
C
SNEWGENF = NEWGENF
NEWGENF = .FALSE.
GENOPEN = .FALSE.
FIRSTTIME = .FALSE.
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
NEWGENF = SNEWGENF
C
C---- Update parameters (eg resolution)
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
C
C---- Trap insufficient input, MODECTRL returned as 99
C
IF (MODECTRL.EQ.99) THEN
LINE = 'Insufficient input, see terminal window'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C
C---- Delete existing predicted pattern
C
CALL MXDDVN(BOX_VEC)
C
C---- Calculate new spot list
C
IFLAGPR = 0
CALL PREDICT(PSI,IFLAGPR)
C
C---- Trap too many reflections generated
C
IF (IFLAGPR.LT.0) THEN
WRITE(LINE,FMT=6210) NREFLS
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
NEWRES = .FALSE.
PREDICTED = .TRUE.
C
C---- Display new pattern
C
CALL DSPPRD(NDISP,MODE)
IF (CIRCLES) THEN
IF (JDSPWD .GT. 0) CALL MXDCIR(
+ NCIRC, RESCMX, DISTANCE, THETA, WAVELENGTH, RESCIR)
ENDIF
C
C---- Menu item "Clear Prediction"
C
ELSEIF (ITEM .EQ. MCLRPRD) THEN
CALL MXDDVN(BOX_VEC)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Menu item " Adjust"
C
ELSE IF (ITEM .EQ. MADJ2) THEN
IF (MODE.NE.5) THEN
CALL DSPADJ(LHELP)
ADJUST = .TRUE.
END IF
C
C---- Menu item "Refine cell" (LABELS 70, FORMAT 6080)
C
ELSE IF (ITEM.EQ.MPREF) THEN
GIVEMAT = .FALSE.
C
C---- Check that a matrix is available
C
IF ((IMAT.EQ.0).AND.(IUMAT.EQ.0)) THEN
LINE = 'Crystal orientation is not defined. Autoindex'
+ //' or supply a matrix'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- Delete found spots
C
CALL MXDDSY
IXM = 200
IYM = 200
LINELEN = 80
NUMLIN = 40
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
IF ((ETA+DIVH)/DTOR.LT.0.01) THEN
LINE = ' '
WRITE(LINE,FMT=6076)
6076 FORMAT('** Warning, both mosaic spread and beam ',
+ 'divergence are very small.')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6078)
6078 FORMAT('This will cause problems in postrefinement.')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6079)
6079 FORMAT(1X,'Do you want to proceed (N):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
GOTO 69
ELSE
CALL MXDCIO(1,0,0,0,0)
GOTO 10
END IF
END IF
C
C---- Message depends on spacegroup,ortho or lower vs rest.
C
69 IF (NUMSPG.LT.75) THEN
LINE = ' '
WRITE (LINE, 6080)
6080 FORMAT (1X, 'For this spacegroup it is advisable to use a ',
+ 'minimum')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6082)
6082 FORMAT (1X, 'of two segments of data separated by as large an')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6084)
6084 FORMAT (1X, 'angle (up to 90) as possible.')
CALL MXDWIO(LINE, 2)
JSEG = 2
ELSE
WRITE (LINE, 6086)
6086 FORMAT (1X, 'For this spacegroup one segment is usually ',
+ 'sufficient')
CALL MXDWIO(LINE, 2)
LINE = ' '
WRITE (LINE, 6088)
6088 FORMAT (1X, 'but two segments may give improved accuracy.')
CALL MXDWIO(LINE, 2)
JSEG = 1
END IF
NSEG = JSEG
C
WRITE(STR2,FMT=6052) NSEG
CALL STRIPSTR(STR2,NCH)
WRITE (LINE, 6090)
6090 FORMAT(1X,'Give number of segments (')
J = LENSTR(LINE)
LINE = LINE(1:J)//STR2(1:NCH)//') :'
70 CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
NSEG = JSEG
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 70
NSEG = NINT(VALUE(1))
IF (NSEG.EQ.0) THEN
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
GOtO 10
END IF
END IF
C
C---- Get information for each segment
C
DO 80 I = 1,NSEG
LINE = ' '
WRITE(STR2,FMT=6052) I
WRITE (LINE, 6092)
6092 FORMAT(1X,'Image number for first image of segment ')
CALL STRIPSTR(STR2,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//' '//STR2(1:NCH)//' ('
IF (IMS1(I).NE.0) THEN
JIMAG = IMS1(I)
ELSE
JIMAG = IDPACK(NIMAG)
END IF
WRITE(STR2,FMT=6052) JIMAG
CALL STRIPSTR(STR2,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//STR2(1:NCH)//') :'
74 CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
IM1 = JIMAG
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 74
IM1 = NINT(VALUE(1))
END IF
IMS1(I) = IM1
IF (I.EQ.1) IPACK1A(I) = IM1
C
C---- Get image identifier
C
WRITE(LINE,6150) IDENT(1:LENSTR(IDENT))
6150 FORMAT(1X,'Image identifier (',A,') :')
CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
IDENTPRF(I) = IDENT
ELSE
IDENTPRF(I) = LINE2(IBEG(1):IEND(1))
END IF
C
C---- If phi values read from image header for first input image
C then use header information by default
C
chrp 31102001 DEFPHI = .FALSE.
IF (ISTRT.EQ.0) THEN
LINE = ' '
WRITE(LINE,FMT=6360)
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
C---- Save PHIBEG in case run is not done
C
c IF (I.EQ.1) THEN
c PHIBEGS = PHIBEG
c IF (STR1.EQ.'Y')GOTO 210
c ENDIF
END IF
C
C---- Get default start phi for this image, needs to be done differently for
C first segment and subsequent ones. Save the first PHIBEG in case run is
C not actually carried out.
C
CAL Must not set DEFPHI true here, as this indicates phi values have been
CAL supplied on the original IMAGE keyword and are to be used in preference
CAL to the values in the header.
cal DEFPHI = .TRUE.
IF (I.EQ.1) THEN
PHIBEGS = PHIBEG
PHIBEG = PHIBEG + (IM1 - IDPACK(NIMAG))*PHIRNG
PHIEND = PHIBEG + PHIRNG
ELSE
PHIBEG = PHIBEG + (IM1 - IMS1(I-1))*PHIRNG
PHIEND = PHIBEG + PHIRNG
END IF
PHIPRF(I) = PHIBEG
OSCPRF(I) = PHIRNG
C
CAL If using header phi values, goto 210
C
IF ((ISTRT.EQ.0).AND.(STR1.EQ.'Y'))GOTO 210
C
CAL Phi values in header not to be used, user supplied values
CAL
DEFPHI = .TRUE.
WRITE(STR4,FMT=6058) PHIBEG
WRITE (LINE, 6094)
6094 FORMAT(1X,'Give starting phi (')
CALL STRIPSTR(STR4,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//STR4(1:NCH)//') :'
76 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 76
PHIBEG = VALUE(1)
END IF
PHIPRF(I) = PHIBEG
LINE = ' '
WRITE(STR3,FMT=6054) PHIRNG
WRITE (LINE, 6096)
6096 FORMAT(1X,'Oscillation angle (')
CALL STRIPSTR(STR3,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//STR3(1:NCH)//') :'
78 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 78
PHIRNG = VALUE(1)
END IF
OSCPRF(I) = PHIRNG
PHIEND = PHIBEG + PHIRNG
C
210 LINE = ' '
JIMAG = 2
CHRP 22121999
C---- for new-style postrefinement, we need to run GENERATE to get the
C spread of partials over frames
C
C---- First check we have an orientation
C
IF ((IMAT.EQ.0).AND.(IUMAT.EQ.0)) THEN
LINE = 'Cannot predict, no orientation given'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- If no AMAT has yet been calculated, do that now
C
IF (IMAT.EQ.0) THEN
ICHECK = 1
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
IMAT = 1
C
C---- Can now set IUMAT to zero, so we do not get error message about
C input I matrix being ignored from predict
C
IUMAT = 0
END IF
C
C---- Need to call CONTROL to set up detector limits etc
C
MODECTRL = 1
C
C---- If GENFILE not set, set a default value
C
IF (IGENF.EQ.0) THEN
GENFILESET = .TRUE.
GENFILE = WAXFN(1:LENSTR(WAXFN))//'.gen'
END IF
C
C---- If no raster parameters given, set up values based on median
C spot size in centre of image. Need to do this here so that the
C new parameters are stored as part of the input
C
IF ((IRAST.EQ.0).OR.(ISEP.EQ.0)) THEN
NEWRAST = (IRAST.EQ.0)
NEWSEP = (ISEP.EQ.0)
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWRAST = .FALSE.
NEWSEP = .FALSE.
GOTO 10
END IF
END IF
C
C---- Set NEWGENF FALSE so it does not CALL START IN CONTROL
C (which opens a generate file and checks raster box)
C
SNEWGENF = NEWGENF
NEWGENF = .FALSE.
GENOPEN = .FALSE.
FIRSTTIME = .FALSE.
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
NEWGENF = SNEWGENF
CHRP 22121999
C
C---- generate list of spots but don't write generate file...
C
CALL GENERATE(2,IM1,.true.,.false.,LIMIT,.true.,
+ NEWPREF,NFGEN,.false.,NFULLF)
IF(IERR.EQ.1)GOTO 10
c
c---- hrp 19102001 ----
IF(NEWPREF)then
C $ JIMAG = MAX(2,INT(((2.0*ETA+DIVH)/DTOR)/PHIRNG)+1)
JIMAG = MAX(2,NIVB)
nadd = jimag
endif
WRITE(STR3,FMT=6052) JIMAG
chrp06092000 WRITE (LINE, 6099)
chrp06092000 6099 FORMAT(1X,'Number of images in Virtual Batch is ')
chrp06092000 CALL STRIPSTR(STR3,NCH)
chrp06092000 J = LENSTR(LINE)
chrp06092000 LINE = LINE(1:J)//' currently '//STR3(1:NCH)//'.'
chrp06092000 CALL MXDWIO(LINE, 2)
chrp06092000 WRITE(STR3,FMT=6052) JIMAG
WRITE (LINE, 6098)
6098 FORMAT(1X,'Number of images in this segment (')
CALL STRIPSTR(STR3,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//STR3(1:NCH)//') :'
79 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 79
JIMAG = VALUE(1)
END IF
IF (JIMAG.LT.2) THEN
LINE = 'Must use at least 2 images... reset to 2'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
JIMAG = 2
LINE = ' '
END IF
IMF1(I) = IM1 + JIMAG - 1
IF (I.EQ.1) IPACK2A(I) = IMF1(I)
C
C---- Once an orientation matrix has been given for one segment, it must
C be given for all subsequent segments because current orientation
C cannot be recovered.
C
IF (.NOT.GIVEMAT) THEN
WRITE (LINE, 6130)
6130 FORMAT(1X,'Use the current crystal orientation (Y) :')
CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
ELSE
STR1 = 'N'
END IF
C
IF (STR1.EQ.'Y') THEN
INMAT(I) = .FALSE.
ELSE
C
C---- Get filename for orientation matrix
C
81 IF (.NOT.GIVEMAT) THEN
WRITE (BIGLINE, 6132)
6132 FORMAT(1X,'Give filename for orientation matrix',
+ ' for this segment: ')
ELSE
WRITE (BIGLINE, 6133) MATFILN(I-1)
+ (1:LENSTR(MATFILN(I-1)))
6133 FORMAT(1X,'Give filename for orientation matrix',
+ ' for this segment (',A,'): ')
END IF
CALL MXDWIO(BIGLINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get filename using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.NE.0) THEN
NCH = IEND(1) - IBEG(1) + 1
IF (NCH.GT.70) THEN
WRITE(LINE,FMT=6135)
6135 FORMAT(1X,'Too many characters (max 70)')
CALL MXDWIO(LINE, 0)
GOTO 81
END IF
MATFILN(I) = LINE2(IBEG(1):IEND(1))
C
C---- Check file exists
C
INQUIRE(FILE=MATFILN(I),EXIST=EFILE)
IF (.NOT.EFILE) THEN
WRITE(BIGLINE,FMT=6134)
+ MATFILN(I)(1:LENSTR(MATFILN(I)))
6134 FORMAT('File ',A,' does not exist')
CALL MXDWIO(BIGLINE, 0)
GOTO 81
END IF
GIVEMAT = .TRUE.
INMAT(I) = .TRUE.
ELSE
C
C---- No filename given. If a matrix supplied for a previous segment
C then use this, otherwise use current orientation
C
IF (I.GT.1) THEN
IF (INMAT(I-1)) THEN
MATFILN(I) = MATFILN(I-1)
INMAT(I) = .TRUE.
END IF
END IF
END IF
END IF
C
C---- End of loop over segments
C
80 CONTINUE
C
C---- Name of output orientation matrix file
C
WRITE (BIGLINE,FMT=6220) NEWMATNAM(1:LENSTR(NEWMATNAM))
85 CALL MXDWIO(BIGLINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get filename using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.NE.0) THEN
NCH = IEND(1) - IBEG(1) + 1
IF (NCH.GT.70) THEN
WRITE(LINE,FMT=6135)
CALL MXDWIO(LINE, 0)
GOTO 85
END IF
NEWMATNAM = LINE2(IBEG(1):IEND(1))
END IF
C
C---- Reflect parameters for run and query
C
NUPR_INT = .FALSE.
SAVMATNAM = NEWMATNAM
NSAVSEG = NSEG
chrp 20092001 INITPHI = PHIPRF(1) + OSCPRF(1)
LINE = ' '
WRITE(LINE,FMT=6100) NSEG
6100 FORMAT(1X,'Post refining cell using',I3,' segments')
CALL MXDWIO(LINE, 3)
C
DO 82 I = 1,NSEG
LINE = ' '
ISFIRST(I) = IMS1(I)
IF (DEFPHI) THEN
WRITE(LINE,FMT=6102) I,IMS1(I),IMF1(I),PHIPRF(I),
+ OSCPRF(I)
6102 FORMAT(1X,'Segment',I3,' images',I5,' to',I5,
+ ' Starting phi',F7.1,
+ ' Osc angle',F5.2)
ELSE
WRITE(LINE,FMT=6107) I,IMS1(I),IMF1(I)
6107 FORMAT(1X,'Segment',I3,' images',I5,' to',I5)
END IF
CALL MXDWIO(LINE, 2)
C
LINE = ' '
WRITE(BIGLINE,6105) IDENTPRF(I)(1:LENSTR(IDENTPRF(I)))
6105 FORMAT(1X,'Image identifier ',A)
CALL MXDWIO(BIGLINE, 2)
C
IF (INMAT(I)) THEN
WRITE(BIGLINE,FMT=6103) I,MATFILN(I)
+ (1:LENSTR(MATFILN(I)))
6103 FORMAT(1X,'Orientation matrix for segment',I2,
+ ' in file: ',A)
CALL MXDWIO(BIGLINE, 2)
END IF
82 CONTINUE
LINE = ' '
C
C---- Do you want to proceed ?
C
WRITE(LINE,FMT=6038)
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
C
IF (STR1.NE.'Y') THEN
PHIBEG = PHIBEGS
GOTO 10
END IF
C
C
C---- Set up parameters
C
C
C----- Save parameters for displaying first image after run or abort
C
RESTID = IMS1(1)
RESTPHIB = PHIPRF(1)
RESTPHIE = PHIPRF(1) + OSCPRF(1)
RESTIDENT = IDENTPRF(1)
IF (TEMPLATE) THEN
RTEMPLSTART = TEMPLSTART
RTEMPLEND = TEMPLEND
END IF
C
C---- If an orientation matrix file has been given for first segment,
C need to read it now and set up matrices
C
IF (INMAT(1)) THEN
CALL CCPDPN (-3,MATFILN(1),'OLD','F',80,IFAIL)
READ (3,FMT=6140,END=83) ((AMAT(I,J),J=1,3),I=1,3),
+ (DELPHI(I),I=1,3)
6140 FORMAT (3F12.6)
CLOSE (UNIT=3)
ICHECK = 1
IMAT = 1
IUMAT = 0
ICELL = 0
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
C---- Do we need to set ICELL = 1 here...what this does is to fix the cell
C parameters to those for this segment, so if a different matrix
C is given for another segment, its cell will not be used.
ICELL = 1
END IF
GOTO 84
C
C---- Eof reading matrix file
C
83 LINE = 'End of file reading orientation matrix'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
C
84 NPACKS = 0
NPACK = 0
NADD = 0
NADDS = 0
ISTARTP = 1
DO 88 I = 1,NSEG
PHIRNG = OSCPRF(I)
if(phirng.eq.0)phirng=phiend-phibeg
IPACKF = IMS1(I)
PHISTART = PHIPRF(I)
NPACKS = IMF1(I) - IMS1(I) + 1
NPACK = NPACK + NPACKS
Chrp310300 NADD = NADD + NPACKS -1
NADD = NADD + NPACKS
c IF(NEWPREF)NADD = INT(ETA*2.0/((PHIEND-PHIBEG)*DTOR))+1
IF(NEWPREF)NADDS = NADDS + MAX(NIVB,(INT(ETA*2.0/
$ (phirng*DTOR))+1))
K = 0
DO 86 J = ISTARTP,NPACK
K = K + 1
IF (J.EQ.ISTARTP) THEN
IDPACK(J) = IPACKF
IF (DEFPHI) PHIBEGA(J) = PHISTART
ELSE
IDPACK(J) = IPACKF + K - 1
IF (DEFPHI) PHIBEGA(J) = ((K-1)*PHIRNG) + PHISTART
END IF
FILMPLOT(J) = .TRUE.
IF (DEFPHI) PHIENDA(J) = PHIBEGA(J) + PHIRNG
IF (DEBUG(65)) THEN
WRITE(IOUT,FMT=6106) J,IDPACK(J),
+ PHIBEGA(J),PHIENDA(J)
IF (ONLINE) WRITE(ITOUT,FMT=6106) J,IDPACK(J),
+ PHIBEGA(J),PHIENDA(J)
6106 FORMAT(1X,'Pack ',I3,' ID',I5,' Phistart',F7.2,
+ ' Phiend',F7.2)
END IF
NFPACK(J) = 1
NFIRST(J) = 1
86 CONTINUE
ISTARTP = ISTARTP + NPACK
88 CONTINUE
c print*,nadd,nadds
c pause
CHRP 20032000 NADD = MAX(NADD,NADDS)
Chrp 310300
NADD = NADD - NSEG
C
C---- Reset NPACK to number of images in first segment
C
NPACK = IMF1(1) - IMS1(1) + 1
C
C---- Set ISTARTP ready for next PROCESS keyword
C
ISTARTP = NPACK + 1
C
MULTISEG = .TRUE.
POSTREF = .TRUE.
SUMPART = .TRUE.
MODECTRL = 4
IFIRSTPACK = 1
NEWGENF = .TRUE.
GENOPEN = .FALSE.
FIRSTTIME = .FALSE.
C
C---- Oscillation angle and start phi have been defined, so don't try to
C get them from header However, save original values so they can be
C restored after this run.
C
IF (DEFPHI) THEN
IF (.NOT.SAVED) THEN
SAVED = .TRUE.
ISTRTSV = ISTRT
IANGLESV = IANGLE
END IF
ISTRT = 1
IANGLE = 1
END IF
C
C---- If GENFILE not set, set a default value
C
IF (GENFILE(1:8).EQ.'________') THEN
GENFILESET = .TRUE.
GENFILE = WAXFN(1:LENSTR(WAXFN))//'.gen'
END IF
C
C---- If no raster parameters given, set up values based on median
C spot size in centre of image. Need to do this here so that the
C new parameters are stored as part of the input
C
IF ((IRAST.EQ.0).OR.(ISEP.EQ.0)) THEN
NEWRAST = (IRAST.EQ.0)
NEWSEP = (ISEP.EQ.0)
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWRAST = .FALSE.
NEWSEP = .FALSE.
GOTO 10
END IF
END IF
C
C---- Now need to go through stored lines of input and comment out
C those not appropriate for MULTISEG refinement so that if entire
C run has to be repeated it will still work.
C
NSAVELINE = NTLINE
C
DO 90 I = 1,NTLINE-1
LINE = INLINE(I)
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) GOTO 90
KEY = LINE(IBEG(1):IEND(1))
CALL CCPUPC(KEY)
IF ((KEY.EQ.'IMAG').OR.(KEY(1:3).EQ.'RUN')
+ .OR.(KEY.EQ.'END').OR.(KEY.EQ.'GO')
+ .OR.(KEY.EQ.'PROC').OR.(KEY.EQ.'SERI')
+ .OR.(KEY.EQ.'CELL').OR.(KEY.EQ.'MISS')
+ .OR.(KEY.EQ.'SYMM').OR.(KEY.EQ.'STRA')
+ .OR.((KEY.EQ.'POST').and..not.(newpref))) THEN
LINE2 = '!'//LINE(1:79)
INLINE(I) = LINE2
ELSE
IF ((KEY.EQ.'POST').AND.(NEWPREF))THEN
INLINE(I) = LINE(1:79)
END IF
ENDIF
90 CONTINUE
C
C---- Now need to add additional lines for multisegrun
C
INLINE(NTLINE) = 'PLOT'
NTLINE = NTLINE + 1
WRITE(LINE,FMT=6122) NSEG
6122 FORMAT('POSTREF SEGMENT',I3)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
C
C---- If DISTANCE was set using parameter window, need to define it with
C a keyword.
C
IF (IDIST.NE.2) THEN
WRITE(LINE,FMT=6131) 0.01*XTOFD
6131 FORMAT('DISTANCE ',F9.2)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
END IF
C
C---- If BEAM was set using parameter window, need to define it with
C a keyword.
C
IF (IBEAM.NE.2) THEN
XBEAM = 0.01*XCEN
YBEAM = 0.01*YCEN/YSCAL
IF (INVERTX) XBEAM = NREC*RAST - XBEAM
WRITE(LINE,FMT=6137) XBEAM,YBEAM
6137 FORMAT('BEAM ',2F9.2)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
END IF
C
C---- If resolution was changed, need to define it with keyword
C
IF (INRES.EQ.2) THEN
WRITE(LINE,FMT=6138) WAVE/DSTMAX
6138 FORMAT('RESOLUTION ',F9.3)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
END IF
C
C---- Add SYMMETRY keyword (may not have been present or may have
C changed)
C
WRITE(LINE,FMT=6125) SPGNAM
6125 FORMAT('SYMMETRY ',A)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
C
C---- If the separation or raster parameters have been set automatically,
C add these to input keywords
C
IF (GENFILESET) THEN
GENFILESET = .FALSE.
WRITE(LINE,FMT=6129) GENFILE(1:LENSTR(GENFILE))
6129 FORMAT('GENFILE ',A)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
END IF
C
C---- Add RASTER
C
IF (NEWRAST) THEN
WRITE(LINE,FMT=6126) IRAS
6126 FORMAT('RASTER',5I5)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
END IF
C
C---- Add SEPARATION
C
IF (NEWSEP) THEN
WRITE(LINE,FMT=6127) 0.01*IXSEP,0.01*IYSEP
6127 FORMAT('SEPARATION',2F6.2)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
END IF
C
C---- Add image filename extension
C
WRITE(LINE,FMT=6139) ODEXT(1:LENSTR(ODEXT))
6139 FORMAT('EXTENSION ',A)
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
C
DO 92 I = 1,NSEG
C
C---- Image identifier
C
BIGLINE = ' '
WRITE(BIGLINE,FMT=6121)
+ IDENTPRF(I)(1:LENSTR(IDENTPRF(I)))
6121 FORMAT('IDENT ',A)
INLINE(NTLINE) = BIGLINE
NTLINE = NTLINE + 1
C
C---- MATRIX keyword... if not given explicitly, use SNEWMATNAM for
C first segment providing it has been written. If it has not,
C then a MATRIX keyword must have been supplied in original input
C so use that
C
IF ((I.EQ.1).AND.(.NOT.INMAT(1)).AND.
+ (INEWMAT.EQ.1)) THEN
WRITE(BIGLINE,FMT=6123)
+ SNEWMATNAM(1:LENSTR(SNEWMATNAM))
6123 FORMAT('MATRIX ',A)
INLINE(NTLINE) = BIGLINE
NTLINE = NTLINE + 1
END IF
C
IF (INMAT(I)) THEN
WRITE(BIGLINE,FMT=6123)
+ MATFILN(I)(1:LENSTR(MATFILN(I)))
INLINE(NTLINE) = BIGLINE
NTLINE = NTLINE + 1
END IF
C
C---- PROCESS keyword
C
IF (DEFPHI) THEN
WRITE(LINE,FMT=6124) IMS1(I),IMF1(I),PHIPRF(I),
+ OSCPRF(I)
6124 FORMAT('PROCESS ',I5,' TO ',I5,' START ',F8.3,
+ ' ANGLE ',F7.3)
ELSE
WRITE(LINE,FMT=6380) IMS1(I),IMF1(I)
6380 FORMAT('PROCESS ',I5,' TO ',I5)
END IF
INLINE(NTLINE) = LINE
NTLINE = NTLINE + 1
C
C---- RUN keyword
C
INLINE(NTLINE) = 'RUN'
NTLINE = NTLINE + 1
IF (I.EQ.1) NRLINE = NTLINE
92 CONTINUE
C
IF (DEBUG(65)) THEN
WRITE(IOUT,FMT=6120) NRLINE,NTLINE,
+ (I,INLINE(I),I=1,NTLINE-1)
IF (ONLINE) WRITE(ITOUT,FMT=6120) NRLINE,NTLINE,
+ (I,INLINE(I),I=1,NTLINE-1)
6120 FORMAT(1X,'NRLINE=',I3,' NTLINE=',I3,/,1X,
+ (/,1X,'Stored line',I3,' is: ',A))
END IF
C
C
C---- Set IDENT to identifier for first segment
C
IDENT = IDENTPRF(1)(1:LENSTR(IDENTPRF(1)))
C
C---- Allow cell refinement
C
DO 94 I = 1,6
FCELL(I) = .FALSE.
94 CONTINUE
C
PRMODE = .FALSE.
PRCELL = .FALSE.
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
C
C---- Trap insufficient input, MODECTRL returned as 99
C
IF (MODECTRL.EQ.99) THEN
LINE = 'Insufficient input, see terminal window'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
NPACK = 0
NSEG = 0
GOTO 10
END IF
C
C---- Return to MAIN with MODE set to 10.
C
MODE = 10
RETURN
C
C
C---- Menu item "Integrate"
C
ELSE IF (ITEM.EQ.MINTEG) THEN
C
C---- Following for integrate option from POWDER display menu
C
C---- Check that a matrix is available
C
IF ((IMAT.EQ.0).AND.(IUMAT.EQ.0)) THEN
LINE = 'Crystal orientation is not defined. Autoindex'
+ //' or supply a matrix'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C--- Check mosaic spread + divergence is > 0
C
IF ((ETA+DIVH)/DTOR.LT.0.01) THEN
IXM = 200
IYM = 200
LINELEN = 70
NUMLIN = 5
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = ' '
WRITE(LINE,FMT=6076)
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6078)
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6079)
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
CALL MXDCIO(1,0,0,0,0)
IF (STR1.EQ.'Y') THEN
GOTO 96
ELSE
GOTO 10
END IF
END IF
C
96 ISTARTP = 1
NSERLOC = 1
NPACK = 0
NPACKS = 0
IBLOCK = 0
chrp 31102001 DEFPHI = .FALSE.
C
C---- Allow cell refinement unless suppressed later
C
DO 98 I = 1,6
FCELL(I) = .FALSE.
98 CONTINUE
C
C---- Delete found spots
C
CALL MXDDSY
C
C---- Get image numbers etc
C
IXM = 200
IYM = 200
LINELEN = 95
NUMLIN = 26
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
C
C---- First check that following parameters have been set :
C BACKSTOP, POLARISATION, DIVERGENCE, GAIN
C
IF ((IGAIN.EQ.0).OR.(.NOT.IIBACK).OR.(IPOLAR.EQ.0).OR.
+ (((IDIVH.EQ.0).OR.(IDIVV.EQ.0)).AND.(ISYN.EQ.1))) THEN
LINE = 'The following parameters have not yet been '//
+ ' defined:'
CALL MXDWIO(LINE, 1)
IF (IGAIN.EQ.0) THEN
WRITE(LINE,FMT=6170) GAIN
6170 FORMAT('Detector gain (GAIN), currently',F5.1)
CALL MXDWIO(LINE, 1)
END IF
IF (.NOT.IIBACK) THEN
WRITE(LINE,FMT=6172) 0.01*RMIN
6172 FORMAT('Backstop shadow (BACKSTOP), current radius',
+ F5.1,'mm centred on direct beam.')
CALL MXDWIO(LINE, 1)
END IF
IF (IPOLAR.EQ.0) THEN
IF (ISYN.EQ.0) THEN
WRITE(LINE,FMT=6174)
6174 FORMAT('Beam polarisation (POLARISATION), assumed'
+ ,' to be unpolarised.')
ELSE
WRITE(LINE,FMT=6176) TOR
6176 FORMAT('Beam polarisation (POLARISATION), assumed'
+ ,' to be',F5.2,' (SRS).')
END IF
CALL MXDWIO(LINE, 1)
END IF
IF ((IDIVH.EQ.0).OR.(IDIVV.EQ.0)) THEN
WRITE(LINE,FMT=6178) DIVH/DTOR,DIVV/DTOR
6178 FORMAT('Beam divergence (DIVERG), ',
+ F5.2,' in plane of rotn axis and',F5.2,
+ ' normal to this.')
CALL MXDWIO(LINE, 1)
END IF
WRITE(LINE,FMT=6180)
6180 FORMAT('Do you want to update any of these (N) :')
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
IF (STR1.NE.'N') THEN
NEWWIN = .FALSE.
CALL MENKW(NEWWIN,LHELP,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST)
END IF
END IF
C
60 WRITE(STR2,FMT=6052) IDPACK(NIMAG)
6052 FORMAT(I4)
CALL STRIPSTR(STR2,NCH)
WRITE (LINE, 6056)
6056 FORMAT('Give first, last image numbers (')
J = LENSTR(LINE)
LINE = LINE(1:J)//STR2(1:NCH)//','//STR2(1:NCH)//') :'
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
IPACKF = IDPACK(NIMAG)
IPACKL = IDPACK(NIMAG)
ELSE IF (NTOK.EQ.1) THEN
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 60
IPACKF = NINT(VALUE(1))
IPACKL = IPACKF
ELSE IF (NTOK.EQ.2) THEN
CALL MKEYNM(2,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 60
IPACKF = NINT(VALUE(1))
IPACKL = NINT(VALUE(2))
ELSE
GOTO 60
END IF
C
C---- If phi values read from image header for first input image
C then use header information by default
C
C Save current value in case the run is not actually done
PHIBEGS = PHIBEG
IF (ISTRT.EQ.0) THEN
LINE = ' '
WRITE(LINE,FMT=6360)
6360 FORMAT('Use phi values from image header ? (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') GOTO 200
END IF
C
C---- Set up PHI values
DEFPHI = .TRUE.
LINE = ' '
WRITE(STR3,FMT=6054) PHIRNG
6054 FORMAT(F4.2)
WRITE (LINE, 6060)
6060 FORMAT('Give oscillation angle (')
CALL STRIPSTR(STR3,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//STR3(1:NCH)//') :'
64 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 64
PHIRNG = VALUE(1)
END IF
C
C---- Starting phi
C
LINE = ' '
C
C---- Get default start phi for this image
C
PHIBEGS = PHIBEG
C---- Change PHIBEG to PHISTIM(NIMAG) on next line.
PHIBEG = PHISTIM(NIMAG) +
+ (IPACKF - IDPACK(NIMAG))*PHIRNG
WRITE(STR4,FMT=6058) PHIBEG
6058 FORMAT(F7.2)
WRITE (LINE, 6062)
6062 FORMAT('Give starting phi (')
CALL STRIPSTR(STR4,NCH)
J = LENSTR(LINE)
LINE = LINE(1:J)//STR4(1:NCH)//') :'
66 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 66
PHIBEG = VALUE(1)
END IF
C
C---- Get BLOCK and ADD values if required
C
200 LINE = ' '
WRITE (LINE, 6064)
6064 FORMAT('Give BLOCK and/or ADD keywords if required')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE (LINE, 6066)
6066 FORMAT('(These are subkeywords of PROCESS keyword): ')
68 CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
ICOUNT = 0
62 ICOUNT = ICOUNT + 1
SUBKEY = LINE2(IBEG(ICOUNT):IEND(ICOUNT))
C **************
CALL CCPUPC(SUBKEY)
C **************
IF (SUBKEY.EQ.'BLOC') THEN
IBLOCK = 1
ICOUNT = ICOUNT + 1
C *******************************************
CALL MKEYNM(1,ICOUNT,LINE2,IBEG,IEND,ITYP,NTOK)
C *******************************************
C
IF (IOERR) GOTO 68
NBLOCK = NINT(VALUE(ICOUNT))
ELSE IF (SUBKEY(1:3).EQ.'ADD') THEN
ICOUNT = ICOUNT + 1
C *******************************************
CALL MKEYNM(1,ICOUNT,LINE2,IBEG,IEND,ITYP,NTOK)
C *******************************************
C
IF (IOERR) GOTO 68
ISERADD = NINT(VALUE(ICOUNT))
ISERAR(1) = ISERADD
END IF
IF (ICOUNT.LT.NTOK) GOTO 62
END IF
C
C---- Check if cell refinement wanted
C
LINE = ' '
WRITE (LINE, 6160)
6160 FORMAT('Refine cell parameters (best done before',
+ ' integration) ? (N):')
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
C
C---- Check there are at least 10 degrees of data if orthorhombic or
C lower symmetry, and at least 2 images if trigonal or higher.
C
TOTPHI = (IPACKL-IPACKF)*PHIRNG
IF (TOTPHI.EQ.0) THEN
LINE = ' '
WRITE(LINE,FMT=6161)
6161 FORMAT('Cannot refine cell from a single image.')
CALL MXDWIO(LINE, 2)
C
C---- Do NOT refine cell
C
DO 119 I = 1,6
FCELL(I) = .TRUE.
119 CONTINUE
PRCELL = .TRUE.
GOTO 126
END IF
IF (NUMSPG.LT.75) THEN
IF (TOTPHI.LT.10.0) THEN
LINE = ' '
WRITE(LINE,FMT=6162) TOTPHI
6162 FORMAT('The total rotation range (',F6.1,' degrees',
+ ') is too small')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6164)
6164 FORMAT('to ensure accurate refinement.')
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6166)
6166 FORMAT('Do you REALLY want to refine cell (N):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.NE.'Y') THEN
DO 120 I = 1,6
FCELL(I) = .TRUE.
120 CONTINUE
GOTO 126
END IF
END IF
END IF
CHRP 22121999
C---- for new-style postrefinement, we need to run GENERATE to get the spread of
C partials over frames
C
C---- First check we have an orientation
C
IF ((IMAT.EQ.0).AND.(IUMAT.EQ.0)) THEN
LINE = 'Cannot predict, no orientation given'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
GOTO 10
END IF
C
C---- If no AMAT has yet been calculated, do that now
C
IF (IMAT.EQ.0) THEN
ICHECK = 1
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
IMAT = 1
C
C---- Can now set IUMAT to zero, so we do not get error message about
C input I matrix being ignored from predict
C
IUMAT = 0
END IF
C
C---- Need to call CONTROL to set up detector limits etc
C
MODECTRL = 1
C
C---- If GENFILE not set, set a default value
C
IF (IGENF.EQ.0) THEN
GENFILESET = .TRUE.
GENFILE = WAXFN(1:LENSTR(WAXFN))//'.gen'
END IF
C
C---- If no raster parameters given, set up values based on median
C spot size in centre of image. Need to do this here so that the
C new parameters are stored as part of the input
C
IF ((IRAST.EQ.0).OR.(ISEP.EQ.0)) THEN
NEWRAST = (IRAST.EQ.0)
NEWSEP = (ISEP.EQ.0)
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWRAST = .FALSE.
NEWSEP = .FALSE.
GOTO 10
END IF
END IF
C
C---- Set NEWGENF FALSE so it does not CALL START IN CONTROL
C (which opens a generate file and checks raster box)
C
SNEWGENF = NEWGENF
NEWGENF = .FALSE.
GENOPEN = .FALSE.
FIRSTTIME = .FALSE.
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
NEWGENF = SNEWGENF
CHRP 22121999
C
C---- generate list of spots but don't write generate file...
C
CALL GENERATE(2,IM1,.true.,.false.,LIMIT,.true.,
+ NEWPREF,NFGEN,.false.,NFULLF)
IF(IERR.EQ.1)GOTO 10
WRITE(STR3,FMT=6052) NIVB
chrp06092000 WRITE (LINE, 6099)
chrp06092000 CALL STRIPSTR(STR3,NCH)
chrp06092000 J = LENSTR(LINE)
chrp06092000 LINE = LINE(1:J)//' currently '//STR3(1:NCH)//'.'
chrp06092000 CALL MXDWIO(LINE, 2)
IF(NEWPREF)
C $ JIMAG = MAX(2,INT(((2.0*ETA+DIVH)/DTOR)/PHIRNG)+1)
$ JIMAG = MAX(2,NADD)
C
C---- Get angular width for post-refinement, default 10 degrees
C for orthorhombic or lower, 5 degrees for higher
C
IF (NUMSPG.LT.75) THEN
PRWIDTH = 10
ELSE
PRWIDTH = 5
END IF
PRWIDTH = MIN(PRWIDTH,TOTPHI)
IF (PHIRNG.NE.0.) THEN
NADD = NINT(PRWIDTH/PHIRNG)
ENDIF
LINE = ' '
WRITE (LINE, 6168) NADD
6168 FORMAT('Number of images to use (',I2,') :')
121 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get numbers using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
CALL MKEYNM(1,1,LINE2,IBEG,IEND,ITYP,NTOK)
IF (IOERR) GOTO 121
I = NADD
NADD = VALUE(1)
IF ((NADD.LT.0).OR.(NADD.GT.(IPACKL-IPACKF)).OR.
$ (NADD.LT.INT(ETA*2.0/(PHIRNG*DTOR))+1))
+ THEN
NADD = I
GOTO 121
c IF(NEWPREF)NADD = INT(ETA*2.0/(PHIRNG*DTOR))+1
END IF
END IF
CAL Why are PRMODE and PRCELL set true...because if not, then when
C integrating a series of images, it will use defaults to decide
C which cell parameters should be refined. We do not want it to refine
C anything, so set these two params .TRUE.
C
PRMODE = .TRUE.
PRCELL = .FALSE.
ELSE
C
C---- Do NOT refine cell
C
IF(NEWPREF)NADD = MAX(NIVB,(INT(ETA*2.0/(PHIRNG*
$ DTOR))+1))
DO 122 I = 1,6
FCELL(I) = .TRUE.
122 CONTINUE
PRCELL = .TRUE.
END IF
C
C---- If MTZFILE not set, set a default value
C
126 IF (IHKLOUT.EQ.0) THEN
IF (TEMPLATE) THEN
IF (NTDIG.EQ.1) THEN
WRITE(STR5,FMT=6311) IPACKF
ELSE IF (NTDIG.EQ.2) THEN
WRITE(STR5,FMT=6312) IPACKF
ELSE IF (NTDIG.EQ.3) THEN
WRITE(STR5,FMT=6313) IPACKF
ELSE IF (NTDIG.EQ.4) THEN
WRITE(STR5,FMT=6314) IPACKF
ELSE IF (NTDIG.EQ.5) THEN
WRITE(STR5,FMT=6315) IPACKF
ELSE IF (NTDIG.EQ.6) THEN
WRITE(STR5,FMT=6316) IPACKF
ELSE IF (NTDIG.EQ.7) THEN
WRITE(STR5,FMT=6317) IPACKF
ELSE IF (NTDIG.EQ.8) THEN
WRITE(STR5,FMT=6318) IPACKF
ELSE IF (NTDIG.EQ.9) THEN
WRITE(STR5,FMT=6319) IPACKF
END IF
ELSE
WRITE(STR5,6063) IPACKF
6063 FORMAT(I3.3)
END IF
MTZNAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ STR5(1:LENSTR(STR5))//'.mtz'
END IF
C
C---- determine BLOCK size if not set
C
IF (IBLOCK.EQ.0) CALL GETBLOCK(IPACKL-IPACKF+1,NBLOCK)
C
C---- See if separate MTZ file for each block wanted
C
I = (IPACKL-IPACKF+1/NBLOCK)
MULTIMTZ = .FALSE.
MTZNAMP = MTZNAM
IF (I.EQ.1) GOTO 192
LINE = ' '
WRITE(LINE,FMT=6370)
6370 FORMAT('Write a new MTZ file for each block of data ?',
+ ' (N) :')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
MULTIMTZ = .TRUE.
NCH = LENSTR(MTZNAM)
DO 190 I = NCH,1,-1
IF (MTZNAM(I:I).EQ.'.') THEN
MTZNAMP = MTZNAM(1:I-1)//'_001'//MTZNAM(I:NCH)
GOTO 192
END IF
190 CONTINUE
ELSE
MTZNAMP = MTZNAM
MULTIMTZ = .FALSE.
END IF
C
C---- Get MTZ filename
C
192 BIGLINE = ' '
WRITE (BIGLINE, 6065) MTZNAMP(1:LENSTR(MTZNAMP))
6065 FORMAT('MTZ filename (',A,') :')
CALL MXDWIO(BIGLINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get filename PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
CONTINUE
ELSE
MTZNAM = LINE2(IBEG(1):IEND(1))
END IF
C
C---- If GENFILE not set, set a default value
C
196 IF (IGENF.EQ.0) THEN
GENFILESET = .TRUE.
I = LENSTR(MTZNAM)
DO 63 J = I,1,-1
IF (MTZNAM(J:J).EQ.'.') THEN
K = J-1
GOTO 65
END IF
63 CONTINUE
K = I
65 GENFILE = MTZNAM(1:K)//'.gen'
END IF
C
C---- Reflect input
C
LINE = ' '
WRITE(LINE,FMT=6068) IPACKF,IPACKL
6068 FORMAT(1X,'Integrating images',I5, ' to',I5)
CALL MXDWIO(LINE, 1)
LINE = ' '
IF(NEWPREF)THEN
WRITE(LINE,FMT=6069)
6069 FORMAT(1X,'Using new-style postrefinement')
CALL MXDWIO(LINE, 1)
NUPR_INT = .TRUE.
ELSE
WRITE(LINE,FMT=6067)
6067 FORMAT(1X,'Using traditional postrefinement')
CALL MXDWIO(LINE, 1)
ENDIF
IF (DEFPHI) THEN
LINE = ' '
WRITE(LINE,FMT=6070) PHIBEG,PHIRNG
6070 FORMAT(1X,'Starting phi',F8.2,' oscillation angle',
+ F5.2)
CALL MXDWIO(LINE, 1)
END IF
LINE = ' '
WRITE(LINE,FMT=6072) NBLOCK
6072 FORMAT(1X,'Images will be integrated in blocks of',I4)
CALL MXDWIO(LINE, 1)
IF (MULTIMTZ) THEN
LINE = ' '
WRITE(LINE,FMT=6075)
6075 FORMAT(1X,'Each block will be written to a separate',
+ ' MTZ file.')
CALL MXDWIO(LINE, 1)
END IF
BIGLINE = ' '
I = MIN(LENSTR(MTZNAM),80)
WRITE(BIGLINE,FMT=6073) MTZNAM(1:I)
6073 FORMAT(1X,'MTZ filename: ',A)
CALL MXDWIO(BIGLINE, 1)
LINE = ' '
WRITE(LINE,FMT=6074) ISERADD
6074 FORMAT(1X,'Batch numbers will be image number plus',I6)
C
CALL MXDWIO(LINE, 1)
IF (((ETA+DIVH)/DTOR.LT.0.01).AND.(IPACKL-IPACKF.GT.0))
+ THEN
LINE = ' '
WRITE(LINE,FMT=6076)
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6078)
CALL MXDWIO(LINE, 1)
END IF
LINE = ' '
WRITE(LINE,FMT=7076)
7076 FORMAT(1X,'Do you want to proceed (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
C
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
C
IF (STR1.NE.'Y') THEN
PHIBEG = PHIBEGS
GOTO 10
END IF
C
C----- Save parameters for displaying first image after run or abort
C
RESTID = IPACKF
RESTPHIB = PHIBEG
RESTPHIE = PHIBEG + PHIRNG
RESTIDENT = IDENT
IF (TEMPLATE) THEN
RTEMPLSTART = TEMPLSTART
RTEMPLEND = TEMPLEND
END IF
C
NSAVELINE = NTLINE
PHISTART = PHIBEG
IPACK1A(NSERLOC) = IPACKF
IPACK2A(NSERLOC) = IPACKL
NPACKS = IPACKL - IPACKF + 1
C
C---- NPACKS is no. of packs in current serial card whereas NPACK is
C the number of packs in total
C
NPACK = NPACK + NPACKS
IF (NPACK.GT.MAXPAX) THEN
C
ELSE
J = 0
DO 100 I = ISTARTP,NPACK
J = J + 1
IF (I.EQ.ISTARTP) THEN
IDPACK(I) = IPACKF
IF (DEFPHI) PHIBEGA(I) = PHISTART
ELSE
IDPACK(I) = IPACKF + J - 1
IF (DEFPHI) PHIBEGA(I) = ((J-1)*PHIRNG)+PHISTART
END IF
FILMPLOT(I) = .TRUE.
IF (DEFPHI) PHIENDA(I) = PHIBEGA(I) + PHIRNG
IF (DEBUG(65)) THEN
WRITE(IOUT,FMT=6106) I,IDPACK(I),
+ PHIBEGA(I),PHIENDA(I)
IF (ONLINE) WRITE(ITOUT,FMT=6106) I,IDPACK(I),
+ PHIBEGA(I),PHIENDA(I)
END IF
CAL***** Need to update this for film
NFPACK(I) = 1
NFIRST(I) = 1
100 CONTINUE
END IF
C
C---- Trap zero increment
C
IF (PHIRNG.LE.0.0) THEN
WRITE(IOUT,FMT=7101)
IF (ONLINE) WRITE(ITOUT,FMT=7101)
IF (BRIEF) WRITE(IBRIEF,FMT=7101)
7101 FORMAT(1X,'*** ERROR ***',/,1X,'The oscillation angle',
+ ' per image must be positive')
GOTO 60
END IF
C
C---- Oscillation angle and start phi have been defined, so don't try to
C get them from header. However, save original values so they can be
C restored after this run.
C
IF (DEFPHI) THEN
IF (.NOT.SAVED) THEN
SAVED = .TRUE.
ISTRTSV = ISTRT
IANGLESV = IANGLE
END IF
ISTRT = 1
IANGLE = 1
END IF
C
C
C---- If no raster parameters given, set up values based on median
C spot size in centre of image.
C
IF ((IRAST.EQ.0).OR.(ISEP.EQ.0)) THEN
NEWRAST = (IRAST.EQ.0)
NEWSEP = (ISEP.EQ.0)
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWRAST = .FALSE.
NEWSEP = .FALSE.
GOTO 10
END IF
END IF
C
IFIRSTPACK = 1
NEWGENF = .TRUE.
GENOPEN = .FALSE.
FIRSTTIME = .FALSE.
IF (DEBUG(65)) THEN
WRITE(IOUT,FMT=7102) NPACK,NPACKS,IFIRSTPACK
IF (ONLINE) WRITE(ITOUT,FMT=7102) NPACK,NPACKS,
+ IFIRSTPACK
7102 FORMAT(1X,'NPACK=',I4,' NPACKS=',I4,' IFIRSTPACK=',I3)
END IF
C
MODECTRL = 2
C
C---- Initialise some variables not set up in CONTROL
C
ISTARTP = 1
C
C---- Must set NRUN =1 because it is not set or incremented when we call
C CONTROL now, and if a previous postref segemnt with 2 segments has
C been done NRUN will be set to 2, which means the MTZ file will not
C be opened for this integration run !
C
NRUN = 1
C
CALL CONTROL(FIRSTTIME,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST,CELLSTR,MODECTRL)
C
C---- Trap insufficient input, MODECTRL returned as 99
C
IF (MODECTRL.EQ.99) THEN
LINE = 'Insufficient input, see terminal window'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
NPACK = 0
GOTO 10
END IF
C
C---- Return to MAIN with MODE set to 9.
C
MODE = 9
RETURN
C
C---- Menu item "Strategy"
C
ELSE IF (ITEM.EQ.MSTRAT) THEN
C
C
C---- If no separation yet given, find it now in case TESTGEN is run.
C
IF (ISEP.EQ.0) THEN
NEWSEP = .TRUE.
MODEGSR = 0
CALL GETSEPRAS(IRAST,ISEP,IRAS,IDPACK(NIMAG),
+ MINDTX,MINDTY,IXSEP,IYSEP,MODEGSR,IERR)
IF (IERR.EQ.1) THEN
NEWSEP = .FALSE.
END IF
END IF
IXM = 200
IYM = 200
LINELEN = 80
NUMLIN = 60
C
C Create IO window
C
CALL MXDCIO(9,LINELEN, NUMLIN, IXM,IYM)
IF (LHELP) THEN
LINE = 'To test the full rotation for this Laue group'//
+ ' just type STRATEGY at the prompt.'
CALL MXDWIO(LINE,1)
LINE = 'To test a smaller rotation (eg 60 degrees) in'//
+ ' 2 different segments type:'
CALL MXDWIO(LINE,1)
LINE = 'STRATEGY SEGMENTS 2 ROTATE 60'
CALL MXDWIO(LINE,1)
LINE ='A suitable speedup factor will be set by default'//
+ ' but can be overridden'
CALL MXDWIO(LINE,1)
LINE = 'eg STRATEGY ROTATE 60 SEGMENTS 2 SPEEDUP 10'
CALL MXDWIO(LINE,1)
LINE ='To try specific phi ranges type : STRATEGY START'//
+ ' -20 END 60'
IF (ICRYST.EQ.3) THEN
CALL MXDWIO(LINE,1)
ELSE
CALL MXDWIO(LINE,3)
END IF
IF (ICRYST.EQ.3) THEN
LINE = '** IMPORTANT ** For orthorhombic space groups'//
+ ' you should also try:'
CALL MXDWIO(LINE,1)
LINE = 'STRATEGY ALT (abbreviaton for ALTERNATE).'
CALL MXDWIO(LINE,1)
LINE = 'This sometimes (rarely) gives better '//
+ 'completeness.'
CALL MXDWIO(LINE,1)
LINE = 'This must be done as a separate STRATEGY run.'
CALL MXDWIO(LINE,3)
END IF
END IF
WRITE(LINE,FMT=6038)
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
CAL CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
C
IF (STR1.NE.'Y') THEN
CALL MXDCIO(1,0,0,0,0)
GOTO 10
ELSE
C
C---- Strategy option uses IMAGE as working space, so must force
C re-reading of image after finishing
STORIMAG = ' '
MODE = 20
RETURN
END IF
C
C---- Menu item "Keyword input"
C
ELSE IF (ITEM.EQ.MKEYWD) THEN
NEWWIN = .TRUE.
CALL MENKW(NEWWIN,LHELP,IFIRSTPACK,NEWGENF,GENOPEN,
+ RPTFIRST)
C
C---- Reset WAVELENGTH in case it has changed
C
WAVELENGTH = WAVE
C
C---- Update parameters in case keyword input has changed any of them
C
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
C
c.....................Menu item " Zoom"
C
ELSEIF (ITEM .EQ. MZOOM) THEN
C
C---- External zoom not working at present
C
I = 0
IF (I.EQ.0) GOTO 10
C
C.....................Menu item " Pick"
C
ELSEIF (ITEM .EQ. MPICK) THEN
LPICK = .NOT. LPICK
IF (LPICK) THEN
IF (MENU2) THEN
MENU_ITEMS2(MPICK) = 'Cancel pick'
ELSE
MENU_ITEMS(MPICK) = 'Cancel pick'
END IF
ELSE
C IF (MENU2) THEN
MENU_ITEMS2(MPICK) = 'Pick'
C ELSE
MENU_ITEMS(MPICK) = 'Pick'
C END IF
IF (PICKED) THEN
c delete SECOND IO box
CALL MXDCIO(11,0,0,0,0)
PICKED = .FALSE.
ENDIF
ENDIF
IF (MENU2) THEN
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
END IF
C
C............................ Measure cell
ELSEIF (ITEM .EQ. MMEAS) THEN
IF (MEASUR .EQ. 0) THEN
MEASUR = +1
IXM = IX
IYM = IY
IF (MENU2) THEN
MENU_ITEMS2(MMEAS) = 'Cancel measure'
ELSE
MENU_ITEMS(MMEAS) = 'Cancel measure'
END IF
ELSE
MEASUR = 0
IF (MENU2) THEN
MENU_ITEMS2(MMEAS) = 'Measure cell'
ELSE
MENU_ITEMS(MMEAS) = 'Measure cell'
END IF
CALL MXDCIO(1,0,0,0,0)
ENDIF
IF (MENU2) THEN
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
END IF
C
C............................ Circles
ELSEIF (ITEM .EQ. MCIRC) THEN
IF (CIRCLES) THEN
c erase circles
CALL MXDDVN(CIR_IVEC)
IF (MENU2) THEN
MENU_ITEMS2(MCIRC) = 'Circles'
ELSE
MENU_ITEMS(MCIRC) = 'Circles'
END IF
CIRCLES = .FALSE.
ELSE
IF (JDSPWD .GT. 0)
+ CALL MXDCIR(
+ NCIRC, RESCMX, DISTANCE, THETA, WAVELENGTH, RESCIR)
IF (MENU2) THEN
MENU_ITEMS2(MCIRC) = 'Erase circles'
ELSE
MENU_ITEMS(MCIRC) = 'Erase circles'
END IF
CIRCLES = .TRUE.
ENDIF
IF (MENU2) THEN
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
END IF
C
C............................Menu item "Fit circles"
ELSEIF (ITEM .EQ. MCIRCF) THEN
C
C----- Fit circles
C
LFITCIRC = .NOT. LFITCIRC
IF (LFITCIRC) THEN
C Now collecting points to fit circle
IF (MENU2) THEN
MENU_ITEMS2(MCIRCF) = 'Fit points'
ELSE
MENU_ITEMS(MCIRCF) = 'Fit points'
END IF
NCIRPT = 0
MCIRPT = 0
C Create io window for output
CALL MXDMKN
ELSE
C Points collected, fit circle
IF (MENU2) THEN
MENU_ITEMS2(MCIRCF) = 'Beam / backstop'
ELSE
MENU_ITEMS(MCIRCF) = 'Beam / backstop'
END IF
CALL FITCIR(
c $ NCIRPT, MCIRPT, IXYCPT, CIRCEN, CIRRAD, YSCAL)
$ NCIRPT, MCIRPT, IXYCPT, CIRCEN, CIRRAD)
C
c-- Update direct beam coordinates
C
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
C
C---- Delete and redraw backstop shadow circle in case it has changed
C
CALL MXDDVN(CIRC_VEC)
ICOLR = 1
IF ((RMINX.NE.0.0).AND.(RMINY.NE.0.0)) THEN
RX = 0.01*RMINX
RY = 0.01*RMINY
ELSE
RX = 0.01*XCEN
RY = 0.01*YCEN
END IF
CALL DSPCIRC(RX,RY,0.01*RMIN,ICOLR)
ENDIF
IF (MENU2) THEN
CALL MXDMNU(MENU_ITEMS2, EXIT_NAME)
ELSE
CALL MXDMNU(MENU_ITEMS, EXIT_NAME)
END IF
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
c............................
ENDIF
c-- reset parameter values in case any have changed
C
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ELSEIF (IVH .EQ. IVHPAR) THEN
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL MXDBSY(-1, ' ')
CALL MXDBSY2(-1, ' ',' ')
CALL MXDPIN(IX,IY,IEXTYZ,
+ DISTANCE,THETA,WAVELENGTH,RESCMX,PSI,
+ NEWRES,NEWSCL,NTHRESH,NSCAL,MODE,POWDER,MODESP,LHELP,
+ IDIST,IBEAM,LPREF,LPINTG,LPAUSE,NEWCELL,NPSI,RFRESH,INRES)
C
C---- If illegal input, refresh parameter table
C
IF (RFRESH) THEN
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
RFRESH = .FALSE.
END IF
C
C---- If PSI angles have been changed, convert PSI to PHI and output
C new values to Output window
C
IF (NPSI) THEN
C PHIAV = (PHIBEG+PHIEND)*0.5 + DELPHI(3)
PHIAV = (PHIBEG+PHIEND)*0.5
C
C **************************
CALL PSITOPHI(PSI,DELPHI,PHIAV)
C **************************
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
NPSI = .FALSE.
END IF
C
C---- Reset XMM, YMM in case direct beam parameters have been updated.
C Note that ALL images will have the direct beam coords updated.
C
XMM(1) = 0.01*(XCEN - CCX)
IF (INVERTX) XMM(1) = NREC*RAST - 0.01*(XCEN - CCX)
YMM(1) = 0.01*(YCEN - CCY)/YSCAL
C
C---- If original direct beam coords were for unswung detector (ISWUNG=0)
C because the values in the parameter window are corrected for the swing
C angle, set ISWUNG=1 now so that the correction is not applied twice.
C
C
IF ((ABS(TWOTHETA).GT.0.0).AND.(ISWUNG.EQ.0))
+ ISWUNG = 1
C
CAL XCEN0 = NINT(XMM(1)*100*YSCAL)
CAL YCEN0 = NINT(100.0*YMM(1) - XTOFD*TAN(TWOTHETA*DTOR))
XCEN0 = NINT(100.0*XMM(1) -
+ COS(OMEGAF)*XTOFD*TAN(TWOTHETA*DTOR))
IF (INVERTX) XCEN0 = NINT(100.0*NREC*RAST-XCEN0)
YCEN0 = NINT(100.0*YMM(1) -
+ SIN(OMEGAF)*XTOFD*TAN(TWOTHETA*DTOR))
C
DO 110 I = 1,MAXPAX
XCENMMIN(I) = XMM(1)
YCENMMIN(I) = YMM(1)
110 CONTINUE
C
C---- If cell parameters have beeen changed, update matrices. First check that
C all cell parameters are known. Also transfer CELL to KCELL so that
C axes will be permuted.
C
IF (NEWCELL) THEN
DO 111 I = 1,6
IF (CELL(I).LE.0.0) NEWCELL = .FALSE.
IF (NEWCELL) KCELL(I) = CELL(I)
111 CONTINUE
END IF
IF (NEWCELL) THEN
ICHECK = 0
IMAT = 0
IUMAT = 1
ICELL = 1
C ************************
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ************************
C---- Reset IMAT to 1, so that we can correctly predict
C
IMAT = 1
IUMAT = 0
END IF
C
IF (NEWRES) THEN
c Reset outer circle position
CALL CRESOL(NXDPX/2,0,
+ DISTANCE, THETA, WAVELENGTH, RESCMX)
CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
ENDIF
IF (NSCAL.OR.(NTHRESH.AND.(LPINTG.AND.(MODE.EQ.5)))) THEN
C
C---- Delete previous residual vector list
C
CALL MXDDVN(IRV_VEC)
CALL DSPRSD
NSCAL = .FALSE.
END IF
c if new circle resolution & circles are drawn then redraw
IF (NEWRES .AND. CIRCLES) THEN
IF (JDSPWD .GT. 0) THEN
CALL MXDDVN(CIR_IVEC)
CALL MXDCIR(
+ NCIRC, RESCMX, DISTANCE, THETA, WAVELENGTH, RESCIR)
ENDIF
ENDIF
C
C---- If new threshold, delete drawn spots and redraw.
C LSPEDIT is TRUE if a spot list has been read in.
IF (NTHRESH.AND.(LSPEDIT.OR.POWDER)) THEN
CAL + (LSPEDIT.OR.(POWDER.AND.(.NOT.PREDICTED)))) THEN
CALL MXDDSY
MODEDISP = 0
CALL DSPSPT(MODEDISP)
NTHRESH = .FALSE.
END IF
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ELSEIF (IVH .EQ. IVHIMG) THEN
c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
CALL MXDBSY(-1, ' ')
CALL MXDBSY2(-1, ' ',' ')
c Image picked, get pixel value
c Clear previous box vectors
CALL MXDDVN(IVECB)
c Fetch both point & rectangle: if rectangle drawn, then getxy returns
c 1st point in rectangle, but if point is picked in the magnify box,
c only the last rectangle is returned
c mark box (if any) as vector class ivecb, colour ivecc
CALL XDLF_IMAGE_GETPIX(IVHIMG, IXP, IYP, IERR)
CALL XDLF_IMAGE_GETRECT(IVHIMG, IX1, IY1, IX2, IY2,
+ IVECB, IVECC, 1, IERR)
IF (IERR .NE. 0) GO TO 999
IF (IXP .NE. IX1 .AND. IYP .NE. IY1) THEN
c If rectangle point different from getxy point, then rectangle is
c out-of-date, so ignore it by setting dummy rectangle
IX1 = IXP
IY1 = IYP
IX2 = IX1
IY2 = IY1
ENDIF
c Convert to image pixels
CAL CALL RPIXCNV(IX1,IY1, RJY,RJZ)
CAL CALL PIXCNV(IX1,IY1, JY,JZ)
CAL CALL PIXCNV(IX2,IY2, JY2,JZ2)
C
C---- If ADJUST is on, store coords
NPX = 0
IF (ADJUST) THEN
IADJP = IADJP + 1
IXADJ(IADJP) = IX1
IYADJ(IADJP) = IY1
IF (IADJP.EQ.4) THEN
CALL ADJREF(IXADJ,IYADJ,IFLAG)
IF (IFLAG.EQ.2) THEN
IADJP = 0
GOTO 10
END IF
C
C---- Update direct beam parameters for all images
C Note that ALL images will have the direct beam coords updated.
C---- Reset XCENF, YCENF so that CCX,CCY will be zero when calculated
C in RDIST. Need to update direct beam coords of ALL images, because
C CCX,CCY will be zero, and XCENMM, YCENMM are used for subsequent images
C in this run (XCENMMIN,YCEMMIN are only used when setting up a new run).
C
C
XCENF = XCEN
YCENF = YCEN
C
C---- If IFLAG is returned as 1, then only XCEN, YCEN are updated, but
C none of the stored direct beam coords, so if this image is processed
C again it will need correcting again !!
C (This is partly because the pack number is not available)
C
IF (IFLAG.EQ.1) GOTO 116
C
DO 114 I = 1,MAXPAX
XCENMM(I,1) = 0.01*(XCEN-CCX)
YCENMM(I,1) = 0.01*(YCEN-CCY)
114 CONTINUE
C
XMM(1) = 0.01*(XCEN - CCX)
IF (INVERTX) XMM(1) = NREC*RAST - 0.01*(XCEN - CCX)
YMM(1) = 0.01*(YCEN - CCY)/YSCAL
C
C---- If original direct beam coords were for unswung detector (ISWUNG=0)
C because the values in the parameter window are corrected for the swing
C angle, set ISWUNG=1 now so that the correction is not applied twice.
C
C
IF ((ABS(TWOTHETA).GT.0.0).AND.(ISWUNG.EQ.0))
+ ISWUNG = 1
C
CAL XCEN0 = NINT(XMM(1)*100*YSCAL)
CAL YCEN0 = NINT(100.0*YMM(1) - XTOFD*TAN(TWOTHETA*DTOR))
C
DO 112 I = 1,MAXPAX
XCENMMIN(I) = XMM(1)
YCENMMIN(I) = YMM(1)
112 CONTINUE
C
C---- Update Xc,Yc, ccomega in Parameter window
C
116 CALL MXDPAR(
+ LDSPSG,JDSPAU,IEXTYZ,JIMGN,DISTANCE,
+ THETA,WAVELENGTH,RESCMX,PSI,LHELP,
+ LPREF,LPINTG,LPAUSE)
ADJUST = .FALSE.
IADJP = 0
END IF
END IF
c If box drawn, calculate mean & rms
CALL DSPAVG(IMAGE(ISTART*IYLEN+1),IYLEN,NREC, IX1,IY1,
+ IX2,IY2, PXAVG,PXRMS,NPX)
IF (NPX .GT. 0) THEN
IZOOM = 1
ELSE
IZOOM = 0
ENDIF
c Calculate resolution
CALL CRESOL(IX1, IY1, DISTANCE, THETA, WAVELENGTH, RESOL)
C
C---- Get indices
C
CALL GETINDX(NDISP,IXP,IYP,IHKL,IRECG)
C
C---- If doing "bad spots" change status of this reflection
C
IF (LBADSP) THEN
CALL BADSPOT(IRECG,BADTOG,IERR)
IF (IERR.NE.0) THEN
IF (IERR.EQ.32) THEN
WRITE(IOUT,FMT=6204)
WRITE(ITOUT,FMT=6204)
LINE = ' '
WRITE(LINE,FMT=6204)
CALL MXDWIO(LINE,2)
ELSE
WRITE(IOUT,FMT=6206)
WRITE(ITOUT,FMT=6206)
LINE = ' '
WRITE(LINE,FMT=6206)
CALL MXDWIO(LINE,2)
END IF
6204 FORMAT(1X,'*** CANNOT CHANGE STATUS OF AN OVERLOAD ***')
6206 FORMAT(1X,'*** CANNOT CHANGE STATUS OF AN OFF-EDGE',
+ ' REFLECTION ***')
ELSE
IF (IRECG.GT.0) THEN
IF (BADTOG) THEN
WRITE(IOUT,FMT=6200) (IHKL(I),I=1,3)
WRITE(ITOUT,FMT=6200) (IHKL(I),I=1,3)
LINE = ' '
WRITE(LINE,FMT=6200) (IHKL(I),I=1,3)
CALL MXDWIO(LINE,2)
ELSE
WRITE(IOUT,FMT=6202) (IHKL(I),I=1,3)
WRITE(ITOUT,FMT=6202) (IHKL(I),I=1,3)
LINE = ' '
WRITE(LINE,FMT=6202) (IHKL(I),I=1,3)
CALL MXDWIO(LINE,2)
END IF
6200 FORMAT(1X,'Reflection',3I4,' changed from bad spot to',
+ ' accepted')
6202 FORMAT(1X,'Reflection',3I4,' changed from accepted to',
+ ' rejected (Bad spot)')
END IF
END IF
CALL MXDDSY
CALL DSPBAD
END IF
C
C---- If editing spots list is active, cancel this spot (negate intensity
C in the file)
C
IF (LKILL) CALL KILLSPT(NSPTD,IXP,IYP)
C
C---- If adding spots, find the c. of g.
C
IF (ADDSPOTS) THEN
IXSPWDTH = MEDWXSPOT
IYSPWDTH = MEDWYSPOT
IXSPBOX = IXSPWDTH + IXSPWDTH
IYSPBOX = IYSPWDTH + IYSPWDTH
CALL ADDSPOT(IXP,IYP,IMAGE(ISTART*IYLEN+1),
+ NREC,IYLEN,IXSPWDTH,IYSPWDTH,IXSPBOX,IYSPBOX,ISTAT)
IF (ISTAT.LT.0) THEN
WRITE(LINE,FMT=6350) NSPOTS
6350 FORMAT('More than',I6,' spots found (parameter NSPOTS)')
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
END IF
END IF
C
c Is Pick active?
IF (LPICK) THEN
c Yes, print figure field
c Print it
CALL DSPPCK(IX1, IY1, IMAGE(ISTART*IYLEN+1),NREC,IYLEN,
+ IEXTYZ, IX1,IY1)
PICKED = .TRUE.
ENDIF
c Is measure active?
IF (MEASUR .GT. 0) THEN
c Store point
MEASPT(1,MEASUR) = IY1
MEASPT(2,MEASUR) = IX1
XMEASPT(1,MEASUR) = REAL(IY1)
XMEASPT(2,MEASUR) = REAL(IX1)
c Draw cross at point
CALL MXDCRS(IX1, IY1, MES_COLR)
IF (MEASUR .EQ. 2) THEN
c 2nd point, ask for number of lattice points
C
C---- Get image number or full file name
C
IXM = 200
IYM = 200
LINELEN = 60
NUMLIN = 3
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = ' '
150 WRITE (LINE, 6300)
6300 FORMAT (1X,'Number of diffraction orders (1) :')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
CALL XDLF_FLUSH_EVENTS(I)
C
C---- Get number using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
NORDER = 1
ELSE
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF (ITYP(1).EQ.2) THEN
NORDER = VALUE(1)
ELSE
WRITE(LINE,FMT=6304)
6304 FORMAT(5X,'Error in input, try again')
CALL MXDWIO(LINE,3)
GOTO 150
END IF
ENDIF
C
CALL DSPCEL(XMEASPT,NORDER,DISTANCE,THETA,WAVELENGTH,
+ SPACNG)
WRITE(LINE,FMT=6302) SPACNG
6302 FORMAT(5X,'Spacing is',F7.2,'A')
CALL MXDWIO(LINE,2)
MEASUR = +1
ELSE
MEASUR = MEASUR + 1
ENDIF
ENDIF
C
c Is CirclePoint active?
IF (LFITCIRC) THEN
c Store point: note that ncirpt is pointer to next point (length of list),
c ncirpt is number of accepted points (ie not counting deleted points)
IF (NCIRPT .GE. MAXCPT) THEN
CAL CALL MXDNEN(
CAL $ '*** Too many circle points, rest ignored ***')
NCIRPT = MAXCPT
ELSE
c If point is very close to existing point, delete it
DO 184, I = 1, NCIRPT
IF (IABS(IX1-IXYCPT(1,I)) .LT. MAXDPT .AND.
$ IABS(IY1-IXYCPT(2,I)) .LT. MAXDPT) THEN
c Yes, delete this point: flag entry as false & redraw all other crosses
IXYCPT(1, I) = -1000
MCIRPT = MCIRPT - 1
CALL MXDDSY
DO 182, J = 1, NCIRPT
IF (IXYCPT(1, J) .GT. 0) THEN
CALL MXDCRS(
$ IXYCPT(1, J), IXYCPT(2, J), MES_COLR)
ENDIF
182 CONTINUE
GO TO 186
ENDIF
184 CONTINUE
c OK, no deletion
NCIRPT = NCIRPT + 1
MCIRPT = MCIRPT + 1
IXYCPT(1,NCIRPT) = IX1
IXYCPT(2,NCIRPT) = IY1
c Draw cross at point
CALL MXDCRS(IX1, IY1, MES_COLR)
ENDIF
186 CONTINUE
ENDIF
CALL MXDNOT(IX1,IY1,RESOL,SPACNG,PXAVG,PXRMS,NPX,
+ NZOOM,RESCIR,NCIRC,IHKL,IRECG,LPINTG)
C
ENDIF
c
c Loop back for wait for next event
GO TO 10
C
C
c Quit entry picked, so close down & exit after a query.
900 IF (LHELP) THEN
CALL MXDBSY(-1, ' ')
CALL MXDBSY2(-1, ' ',' ')
C
C---- Check to go ahead
C
IXM = 200
IYM = 200
LINELEN = 72
NUMLIN = 6
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
LINE = 'WARNING, the image display will be closed.'
CALL MXDWIO(LINE,1)
C
C---- Allow saving file
C
LINE = 'Do you want to save the current parameters ? (Y)'
CALL MXDWIO(LINE,1)
C
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
IF (STR1.EQ.'Y') THEN
SAVENAM = WAXFN(1:LENSTR(WAXFN))//'_'//
+ IMGNUM(1:LENSTR(IMGNUM))//'.sav'
WRITE(LINE,FMT=6240) SAVENAM(1:LENSTR(SAVENAM))
6240 FORMAT('Name of save file (',A,') :')
902 CALL MXDWIO(LINE, 0)
CALL MXDRIO(LINE2)
C
C---- Get filename using PARSER
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.NE.0) THEN
NCH = IEND(1) - IBEG(1) + 1
IF (NCH.GT.70) THEN
WRITE(LINE,FMT=6135)
CALL MXDWIO(LINE, 0)
GOTO 902
END IF
SAVENAM = LINE2(IBEG(1):IEND(1))
END IF
LINE = 'This file can be used as input to a processing job.'
CALL MXDWIO(LINE,1)
CALL SAVEINP
END IF
C
IF (.NOT.POWDER) THEN
LINE = 'Use the "Continue" option to keep'//
+ ' display open during processing'
CALL MXDWIO(LINE,1)
END IF
C
WRITE(LINE,FMT=6280)
6280 FORMAT(1X,'Do you want to exit (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
IF (STR1.NE.'Y') GOTO 10
END IF
CALL DSPDEL
DISPMENU = .FALSE.
STORIMAG = ' '
C
C---- If in POWDER mode, set PHIBEG=PHIEND=0 so that if another image
C is read in for finding spots without giving the phi values, the
C program will correctly prompt for them if "find spots" is chosen.
C
C Also set WAITINP so that a STRATEGY run with moree than one part
C will work correctly (otherwise tries to read data from INLINE after
C the first STRATEGY keyword has been read, because FIRSTTIME is no
C longer TRUE
C Also set NRUN to zero for the same reason
C
IF (POWDER) THEN
PHIBEG = 0.0
PHIEND = 0.0
NSPTD = 0
WAITINP = .TRUE.
NRUN = 0
END IF
C
RETURN
C
c
999 CALL MXDERR('MXDSPL: error',ISTAT,IERR)
END
C
C
SUBROUTINE MXDWIO(LINE, NEWLIN)
C ==============================
c
c Write line to io window
c
c Input:
c line string to print
c newlin = 0 no newlines, = 1 newline before string,
c = 2 newline after string, = 3 newlines before & after
c
C If NEWLIN is > 10, write to second i/o window (IVHIO2)
C If NEWLIN is > 20, write to third i/o window (IVHIO3)
C
IMPLICIT NONE
C
CHARACTER*(*) LINE
INTEGER NEWLIN
C
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
INTEGER LENSTR, L, IERR, NL
EXTERNAL LENSTR
C
NL = NEWLIN
IF (NEWLIN.GE.20) THEN
NL = NL - 20
ELSE IF (NEWLIN.GT.10) THEN
NL = NL - 10
END IF
L = LENSTR(LINE)
CAL IF (L.GT.0) WRITE(IOUT,FMT=100) LINE(1:L)
100 FORMAT(1X,'Output to window: ',A)
C
IF (NEWLIN.GE.20) THEN
CALL XDLF_IO_WINDOW_PRINT(IVHIO3, XDLSTR(LINE),L,NL,IERR)
ELSE IF (NEWLIN.GE.10) THEN
CALL XDLF_IO_WINDOW_PRINT(IVHIO2, XDLSTR(LINE),L,NL,IERR)
ELSE
CALL XDLF_IO_WINDOW_PRINT(IVHIO, XDLSTR(LINE),L,NL,IERR)
END IF
RETURN
END
c neoctrl.f
c maintained by G.Winter
c 16th April 2002
c
c This subroutine is a replacement for mxdspl, to implement the new
c functionality needed for the gui and separate out the actual
c implementation of this functionality from the switching between the
c functions.
c
c This should be something along the lines of if this else if that.
c
c
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
subroutine neoctrl
c specification
c 1. This is a replacement for mxdspl
c 2. It should behave a little like a new command line input route
c 3. This shouldn't do anything, just call the appropriate routine
c based on the first word of the command line.
c The includes
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/gui.f
c gui.h
c maintained by G.Winter
c 16th April 2002
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c This defines the variables and common blocks which are used by the
c new gui control routine. This will also be used in xdisp and control,
c to switch the new gui on!
c
c
logical gui_switch
integer nargs
parameter (nargs = 200)
common /gui/ gui_switch
C&&*&& end_include ../inc/gui.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
c The local variables
c First, those used in parsing - note that these shouldn't be `used' here
character line*400
integer starts(nargs), ends(nargs), lengths(nargs), types(nargs)
integer argc, i
character*80 argv(nargs), firstword
real values(nargs)
c Next, those used in determining what happens
logical inloop
inloop = .true.
c now enter the main loop
1 format(1x, 'NeoCtrl =>', $)
do while(inloop)
c First, get the input line and parse it
c send something to indicate that we're ready for an input
c or read something from the command line
if(socklo) then
line = ''
call write_socket_length(serverfd, lenstr(line), line)
line = ' '
call read_socket(serverfd, line)
call mparse(line, starts, ends, types, values, lengths,
+ argc)
else
write(*, fmt = 1)
call mparser(itin, iout, line, starts, ends, types,
+ values, lengths, argc)
end if
firstword = line(starts(1):ends(1))
call ccplwc(firstword)
c create a list of the rest of the arguments
do i = 1, argc
argv(i) = line(starts(i):ends(i))
end do
c check the keyword against a list of possible values - if we find it,
c call that subroutine with argc, argv, types, values as the arguments
if(firstword .eq. 'create_image') then
call create_image(argc, argv, types, values)
else if(firstword .eq. 'image_data') then
call image_data(argc, argv, types, values)
else if(firstword .eq. 'load_image') then
call load_image(argc, argv, types, values)
else if(firstword .eq. 'find_spots') then
call find_spots(argc, argv, types, values)
else if(firstword .eq. 'predict_spots') then
call predict_spots(argc, argv, types, values)
else if(firstword .eq. 'estimate_mosaicity') then
call estimate_mosaicity(argc, argv, types, values)
else if(firstword .eq. 'return') then
inloop = .false.
else
if(.not. socklo) then
write(*, *) 'Input not recognised'
end if
end if
end do
end
C== MEANPRO ==
C
SUBROUTINE NEWBOX(OD,NXX,NYY,NX,NY,OD2)
C ======================================
C
C---- Given a box of size NXX*NYY in array OD, return OD2 with a size
C NX by NY. If the output box is smaller, it is simply extracted
C from the input box, if it is larger the edge values are used to
C expand the input box.
C
C****** DEBUG(22) FOR THIS SUBROUTINE ******
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NX,NY,NXX,NYY
C ..
C .. Array Arguments ..
INTEGER*2 OD(NXX*NYY),OD2(NX*NY)
C ..
C .. Local Scalars ..
INTEGER IHNX,IHNY,J,IHX,IHY
C ..
C .. Local Arrays ..
INTEGER*2 IOD(-MAXDIM/2:MAXDIM/2,-MAXDIM/2:MAXDIM/2)
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
C ..
C
C
C---- Move pixel values into a 2D array
C
IHNX = NXX/2
IHNY = NYY/2
J = 0
DO 10 IX = -IHNX,IHNX
DO 20 IY = -IHNY,IHNY
J = J + 1
IOD(IY,IX) = OD(J)
20 CONTINUE
10 CONTINUE
C
IHX = NX/2
IHY = NY/2
J = 0
DO 30 IX = -IHX,IHX
DO 40 IY = -IHY,IHY
J = J + 1
OD2(J) = IOD(IY,IX)
C
C---- Now fill in missing rows/columns
C
IF (IX.LT.-IHNX) OD2(J) = IOD(IY,IX+1)
IF (IX.GT.IHNX) OD2(J) = IOD(IY,IX-1)
IF (IY.LT.-IHNY) OD2(J) = IOD(IY+1,IX)
IF (IY.GT.IHNY) OD2(J) = IOD(IY-1,IX)
C
C---- Now the corners
C
IF ((IX.LT.-IHNX).AND.(IY.LT.-IHNY)) OD2(J) = IOD(IY+1,IX+1)
IF ((IX.LT.-IHNX).AND.(IY.GT.IHNY)) OD2(J) = IOD(IY-1,IX+1)
IF ((IX.GT.IHNX).AND.(IY.LT.-IHNY)) OD2(J) = IOD(IY+1,IX-1)
IF ((IX.GT.IHNX).AND.(IY.GT.IHNY)) OD2(J) = IOD(IY-1,IX-1)
40 CONTINUE
30 CONTINUE
C
END
C==== NEWFN ====
SUBROUTINE NEWFN(NUMBLOCK,MTZNAM)
C ===============================
C
C---- Create a new filename for the next block of images, using the
C sequential number of that block
C
C NUMBLOCK Number of the next block
C MTZNAM Current MTZ filename, updated.
C
IMPLICIT NONE
C
C
C .. Parameters ..
C
C ..
C .. Scalar Arguments ..
INTEGER NUMBLOCK
CHARACTER MTZNAM*(*)
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
integer I,NCH
CHARACTER STR3*3
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
WRITE(STR3,FMT=6000) NUMBLOCK
6000 FORMAT(I3.3)
NCH = LENSTR(MTZNAM)
DO 10 I = NCH,1,-1
IF (MTZNAM(I:I).EQ.'.') THEN
MTZNAM = MTZNAM(1:I-4)//STR3//MTZNAM(I:NCH)
GOTO 20
END IF
10 CONTINUE
20 RETURN
END
C== NEWLIST ==
C
C
C
SUBROUTINE NEWLIST(ETANEW,PSI,PHIAV,RESOL,IFLAG)
C ================================================
C
C This routine is only called by AUTOMATCH
C
C---- Generate a list of reflections for the current orientation
C (stored in PSI) with beam divergences (including contribution
C from crystal mosaic spread) dependant on ETANEW and the value
C of IFLAG as follows:
C IFLAG 0 Increase DIVH and DIVV by ETANEW
C IFLAG 2 Increase DIVV by ETANEW, reset DIVH to SDIVH
C IFLAG 2 Increase DIVH by ETANEW, reset DIVV to SDIVV
C IFLAG 4 Set DIVH and DIVV to ETANEW
C IFLAG 5 Set DIVH to ETANEW, DIVV to SDIVV
C IFLAG 6 Set DIVV to ETANEW, DIVH to SDIVH
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
REAL ETANEW,PHIAV,RESOL
INTEGER IFLAG
C ..
C .. Array Arguments ..
REAL PSI(3)
C ..
C .. Local Scalars ..
REAL CX,CY,DTOR,PI,SX,SY
INTEGER NFILMS,MODERK
C ..
C .. Local Arrays
INTEGER*2 ITEMP(1)
C ..
C .. External Subroutines ..
EXTERNAL OVERLAP,PSITOPHI,REEK
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN,COS,SIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/saveit.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file saveit.h
C---- START of include file saveit.h
C
C
C .. Scalars in common block /SAVEIT/ ..
REAL SETA,SDIVH,SDIVV
C ..
C .. Arrays in common block /SAVEIT/ ..
REAL SDELPHI
C .. Common Block /SAVEIT/ ..
COMMON /SAVEIT/SDELPHI(3),SETA,SDIVH,SDIVV
C ..
C
C
C&&*&& end_include ../inc/saveit.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C
SAVE
C
PI = ATAN(1.0)*4.0
DTOR = PI/180.0
C
C---- Set resolution limts, no overlap checking
C
DSTMAX = WAVE/RESOL
DSTPL = DSTMAX
DSTPL2 = DSTPL*DSTPL
C
C---- Convert psi to phi
C
C **************************
CALL PSITOPHI(PSI,DELPHI,PHIAV)
C **************************
C
C---- Update divh,divv by etanew (update divergences rather then
C eta because of the way reeke works)
C when creating the big list, increase both divergences,
C when refining psiy increase vertical divergence and
C when refining psiz increase horizontal divergence.
C
IF (IFLAG.EQ.0) THEN
DIVH = 0.5*ETANEW*DTOR + SDIVH
DIVV = 0.5*ETANEW*DTOR + SDIVV
ELSE IF (IFLAG.EQ.2) THEN
DIVH = SDIVH
DIVV = 0.5*ETANEW*DTOR + SDIVV
ELSE IF (IFLAG.EQ.3) THEN
DIVH = 0.5*ETANEW*DTOR + SDIVH
DIVV = SDIVV
C
ELSE IF (IFLAG.EQ.4) THEN
DIVH = 0.5*ETANEW*DTOR
DIVV = 0.5*ETANEW*DTOR
ELSE IF (IFLAG.EQ.5) THEN
DIVV = SDIVV
DIVH = 0.5*ETANEW*DTOR
ELSE IF (IFLAG.EQ.6) THEN
DIVH = SDIVH
DIVV = 0.5*ETANEW*DTOR
END IF
C
C---- Initialise RMC matrix - for the X and Y missetting angles.
C Rotation about x and then y
C RMC = PHIY . PHIX
C
SX = SIN(DELPHI(1)*DTOR)
SY = SIN(DELPHI(2)*DTOR)
CX = COS(DELPHI(1)*DTOR)
CY = COS(DELPHI(2)*DTOR)
C
RMC(1,1) = CY
RMC(1,2) = SX*SY
RMC(1,3) = CX*SY
RMC(2,1) = 0.0
RMC(2,2) = CX
RMC(2,3) = -SX
RMC(3,1) = -SY
RMC(3,2) = SX*CY
RMC(3,3) = CX*CY
NSPOT = 0
C
IF (DEBUG(30)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) DELPHI,ETA,DSTMAX,DSTPL,
+ PHIBEG,PHIEND,RMIN,RMAX,DIVH,DIVV
WRITE (IOUT,FMT=6000) DELPHI,ETA,DSTMAX,DSTPL,PHIBEG,PHIEND,
+ RMIN,RMAX,DIVH,DIVV
END IF
C
MODERK = 0
CALL REEK(ITEMP(1),MODERK)
CALL OVERLAP
C
C---- Format statements
C
6000 FORMAT (/1X,'IN NEWLIST',/1X,'DELPHI ',3F6.2,' ETA ',F6.4,' DSTM',
+ 'AX ',F7.4,' DSTPL ',F7.4,/1X,'PHIBEG,END ',2F6.2,' RMIN,',
+ 'RMAX ',2F7.2,' DIVH,V ',2F6.4)
C
C
END
C== NEWMASK ==
SUBROUTINE NEWMASK(INMASK,LMASK,NXX,NYY,HX,HY)
C
IMPLICIT NONE
C
C---- Sets output array LMASK equal to input array INMASK, but then
C sets LMASK to 1 for all pixels that have any neighbours
C that are peak pixels (flagged with INMASK value of 1)
C
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NXX,NYY,HX,HY
C ..
C .. Array Arguments ..
INTEGER INMASK(MAXBOX),LMASK(MAXBOX)
C ..
C .. Local Scalars ..
INTEGER I,J,IJ
LOGICAL XOK
C ..
C .. Local Arrays ..
INTEGER MASK(-MXDOV2-1:MXDOV2+1,-MXDOV2-1:MXDOV2+1)
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
C ..
C
C---- Set up MASK to equal INMASK within measurement box and 99 outside it
C
IJ = 0
DO 10 I = -HX-1, HX+1
XOK = ((I.GT.(-HX-1)).AND.(I.LT.(HX+1)))
DO 12 J = -HY-1, HY+1
MASK(J,I) = 99
IF (XOK.AND.((J.GT.(-HY-1)).AND.(J.LT.(HY+1)))) THEN
IJ = IJ + 1
MASK(J,I) = INMASK(IJ)
LMASK(IJ) = INMASK(IJ)
END IF
12 CONTINUE
10 CONTINUE
C
C---- Now test all non-peak pixels for a neighbouring peak pixel
C
IJ = 0
DO 40 I = -HX,HX
DO 30 J = -HY,HY
IJ = IJ + 1
C
C---- Skip if this is anything but a background pixel
C
IF (INMASK(IJ).NE.0) GOTO 30
C
C---- Test all 8 neighbours
C
IF ((MASK(J-1,I-1).EQ.1).OR.
+ (MASK(J,I-1).EQ.1).OR.(MASK(J+1,I-1).EQ.1).OR.
+ (MASK(J-1,I).EQ.1).OR.(MASK(J+1,I).EQ.1).OR.
+ (MASK(J-1,I+1).EQ.1).OR.(MASK(J,I+1).EQ.1).OR.
+ (MASK(J+1,I+1).EQ.1)) LMASK(IJ) = 1
30 CONTINUE
40 CONTINUE
END
C== NEWRMS ==
SUBROUTINE NEWRMS(OD,HX,HY,MASK,MASKREJ,RMSBGN)
C =============================================
IMPLICIT NONE
C
C
C
C---- Determine new RMSBG in backgropund region after excluding all
C background pixels next to peak pixels or next to background
C pixels overlapped by neighbouring spots, for use it determining
C quality of standard profiles.
C
C MASK is an integer array denoting the status of each pixel.
C Its values are NOT changed.
C Values in MASK are:
C
C -1 Background pixel
C 0 Rejected background pixel (overlapped by neighbouring spot)
C 1 Peak pixel
C
C Elements of ASPOT (This array IS updated)
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL RMSBGN
INTEGER HX,HY
C ..
C .. Array Arguments ..
INTEGER MASK(MAXBOX),OD(MAXBOX),MASKREJ(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,B,C,RMSBG,SBGOD,DEL
INTEGER I,J,IJ,IOD,N,P,Q,NBREJ,IWX,IWY,MAXPIX,IDR
LOGICAL XOK
C ..
C .. Local Arrays ..
INTEGER LMASK(-MXDOV2-1:MXDOV2+1,-MXDOV2-1:MXDOV2+1),
+ MODMASK(MAXBOX),MASKREJP(NREJMAX),LMASKREJP(NREJMAX)
C ..
C .. External Subroutines ..
EXTERNAL ODPLOT4R
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C)
C ..
SAVE
C
MASKREJP(1) = 0
LMASKREJP(1) = 0
IDR = 1
C
C
C---- Set up LMASK to equal MASK within measurement box and 99 outside it
C
IJ = 0
DO 20 I = -HX-1, HX+1
XOK = ((I.GT.(-HX-1)).AND.(I.LT.(HX+1)))
DO 10 J = -HY-1, HY+1
LMASK(J,I) = 99
IF (XOK.AND.((J.GT.(-HY-1)).AND.(J.LT.(HY+1)))) THEN
IJ = IJ + 1
LMASK(J,I) = MASK(IJ)
MODMASK(IJ) = MASK(IJ)
C
C---- Set flag for peak pixels also to zero
C Input array MASK has values of 1 for peak pixels.
C
IF (LMASK(J,I).EQ.1) LMASK(J,I) = 0
END IF
10 CONTINUE
20 CONTINUE
C
C---- Now test all unflagged pixels for a neighbouring flagged one.
C
IJ = 0
DO 40 I = -HX,HX
DO 30 J = -HY,HY
IJ = IJ + 1
C
C---- Skip if this is a overlappped pixel
C
IF (MODMASK(IJ).EQ.0) GOTO 30
C
C---- Test all 8 neighbours
C
IF ((LMASK(J-1,I-1).EQ.0).OR.
+ (LMASK(J,I-1).EQ.0).OR.(LMASK(J+1,I-1).EQ.0).OR.
+ (LMASK(J-1,I).EQ.0).OR.(LMASK(J+1,I).EQ.0).OR.
+ (LMASK(J-1,I+1).EQ.0).OR.(LMASK(J,I+1).EQ.0).OR.
+ (LMASK(J+1,I+1).EQ.0)) MODMASK(IJ) = 0
30 CONTINUE
40 CONTINUE
C
C---- Now reject outliers
C
NBREJ = MASKREJ(1)
IF (NBREJ.GT.0) THEN
DO 50 I = 1,NBREJ
IJ = MASKREJ(I+1)
MODMASK(IJ) = 0
50 CONTINUE
END IF
C
C---- Now calculate new RMSBG excluding flagged pixels
C
IJ = 0
N = 0
SBGOD = 0.0
C
C
DO 70 P = -HX,HX
DO 60 Q = -HY,HY
IJ = IJ + 1
IOD = OD(IJ)
C
C
IF (MODMASK(IJ).EQ.-1) THEN
DEL = (IOD - (P*A + Q*B + C))
SBGOD = SBGOD + DEL*DEL
N = N + 1
END IF
C
60 CONTINUE
70 CONTINUE
C
MAXPIX = 0
IWX = 2*HX+1
IWY = 2*HY+1
IF (DEBUG(53)) CALL ODPLOT4R(OD,IWX,IWY,IDR,MODMASK,MASKREJ,
+ MASKREJP,LMASKREJP,MAXPIX)
IF (N.GT.10) THEN
RMSBGN = SQRT(SBGOD/REAL(N))
ELSE
RMSBGN = RMSBG
END IF
IF (DEBUG(53)) THEN
WRITE(IOUT,FMT=6000) N,RMSBG,RMSBGN
IF (ONLINE) WRITE(ITOUT,FMT=6000) N,RMSBG,RMSBGN
6000 FORMAT(1X,'Number of background pixels after rejection',I4,
+ /,1X,'Original RMSBG',F7.1,' Updated RMSBG',F7.1)
END IF
C
END
C== NEXT ==
SUBROUTINE NEXT(LIST,IXSHIFT,IYSHIFT,PRECESS,MATCH,IFAIL,PARTLS,
+ ADDPART,CENTRAL)
C ================================================================
C
IMPLICIT NONE
C
C Bug in correction of 14/2/90 fixed 20/3/90
C Last modified 14/2/90 to trap reflections outside scanned limits
C Last modified 11/7/89 to allow use of partials in refinement
C Last modified 6/10/88
C
C****** DEBUG(13) FOR THIS SUBROUTINE ******
C
C LIST If true, find the centre of gravity of an existing
C list of reflections.
C
C If false, find spots suitable for refinement.
C
C IXSHIFT are the measurement box shifts applied to the
C IYSHIFT calculated (c of g) positions.
C
C IFAIL Flag, normally zero, returned as -1 if no spots found
C for refinement.
C
C PARTLS... true: accept partially recorded reflections
C otherwise reject partials
C
C ADDPART.. True if partials on adjacent images are added together
C during reflection integration.
C In this case, if PARTLS is true, select only those
C partials at end of current image and add in the other
C part of the partial from the next image.
C
C---- Parameters refined are film centre,
C crystal to film distance,
C film orientation
C and distortion parameters
C
C---- Using spots chosen from those measured on a previous film pack.
C the observed c. of g. of these spots is passed through /rfs/ to
C rdist (or rvdist).
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IFAIL,IXSHIFT,IYSHIFT
LOGICAL LIST,MATCH,PRECESS,PARTLS,ADDPART,CENTRAL
C ..
C .. Local Scalars ..
REAL DELX,DELY,FX,FY,SOD,XC,XCAL,XSIZBIN,YC,YCAL,YSIZBIN,
+ SDELX,SDELY
INTEGER I,IADDR,IBLK,IFRST,IFX,IFY,IHWX,II,ILAST,IND,INDF,
+ INDL,INDX,INT,ISDR,IXPIX,IYPIX,J,JJ,JREC,K,KMN,KMX,MAXB,
+ MAXN,MAXW,MINDL,MJ,N1,N2,NC,NECX,NECY,NJ,NREF,NROVR,
+ NRSOLD,NRX,NRY,NSDRP,NXS,NXX,NXY,NYS,NYY,NBGBAD,NBGBADG,
+ XLOW,XHIGH,YLOW,YHIGH,SHX,SHY,NPBOX,IPART,NDBG,NZPBAD,
+ IFLAG,IR,IM,IR1,IR2
LOGICAL FULL,VALONGY
C ..
C .. Local Arrays ..
INTEGER HWX(62),HWY(62),ISPOT(62),IWX(62),LRAS(5),
+ PNTR(62),IRECNO(62),X(62),Y(62)
INTEGER*2 IARR(MAXBUFF/2)
C ..
C .. External Subroutines ..
EXTERNAL BSWAP,CGFIT,PXYCALC,RDBLK,SORTUP3,MMTOPX,GETBOX,BSWAP2
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MOD,NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/trev.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file trev.h
C---- START of include file trev.h
C
C
C .. Scalars in Common block /TREV/ ..
INTEGER NXMAX,NYMAX
C ..
C .. Common Block /TREV/ ..
COMMON /TREV/NXMAX,NYMAX
C ..
C
C
C&&*&& end_include ../inc/trev.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/params.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file params.h
C---- START of include file params.h
C
C
C .. Scalars in common block /PARAMS/ ..
INTEGER NSDR
C ..
C .. Common Block /PARAMS/ ..
COMMON /PARAMS/NSDR
C ..
C
C
C
C&&*&& end_include ../inc/params.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C Extra common blocks
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (IDUM,IARR)
EQUIVALENCE (LRAS(1),NXX), (LRAS(2),NYY)
C ..
SAVE
DATA NDBG/0/
C
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IR2 = 30*IPAD + 30
C
C---- Define limits for coordinates of reflections,
C allowing for maximum possible measurement box size
C
XLOW = XSCMIN + (NXMAX/2 +1)
XHIGH = XSCMAX - (NXMAX/2 + 1)
YLOW = NYMAX/2 + 1
YHIGH = IYLEN - (NYMAX/2 + 1)
C
C
IFAIL = 0
VALONGY = (VEE .AND. (.NOT.VALONGX))
NBGBAD = 0
NBGBADG = 0
NZPBAD = 0
NROVR = 0
C
C
DO 10 I = 3,5
LRAS(I) = IRAS(I)
10 CONTINUE
C
C
NECX = XCEN*FACT + 0.5
NECY = YCEN*FACT + 0.5
IF (LIST) NRSOLD = NRS
NRS = 0
C
C
IF (DEBUG(13)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6001) XLOW,XHIGH,YLOW,YHIGH,LIST,
+ NRSOLD
6001 FORMAT(/1X,' In Subroutine NEXT',/1X,' XLOW, XHIGH, YLOW,',
+ ' YHIGH ',4I6, ' LIST ', L1,' NRSOLD',I5)
WRITE (IOUT,FMT=6001) XLOW,XHIGH,YLOW,YHIGH,LIST,NRSOLD
END IF
C
C---- If using an existing list of reflections, get scanner coords
C
IF (LIST) THEN
NREF = NRSOLD
C
C
DO 20 I = 1,NREF
C
C---- IABS because of option to allow use of partials in positional
C refinement
C
JREC = RRS(I)
IRECNO(I) = JREC
IF (JREC.LT.0) JREC = -JREC
XC = XG(JREC)
YC = YG(JREC)
C
C
IF (PRECESS) THEN
C
C ************************
CALL PXYCALC(XCAL,YCAL,XC,YC)
C ************************
C
ELSE
C
C ***********************
CALL MMTOPX(XCAL,YCAL,XC,YC)
C ***********************
C
END IF
C
C
X(I) = NINT(XCAL*FACT)
Y(I) = NINT(YCAL*FACT)
20 CONTINUE
C
C
ELSE
C
C---- No list supplied, test all spots
C
DO 30 I = 1,60
ISPOT(I) = 0
30 CONTINUE
C
C---- Find maximum X and Y generate file coordinate
C
DO 32 I = 1,TOSPT
IXPIX = NINT(XG(I))
IXPIX = ABS(IXPIX)
MAXX = MAX(MAXX,IXPIX)
IYPIX = NINT(YG(I))
IYPIX = ABS(IYPIX)
MAXY = MAX(MAXY,IYPIX)
32 CONTINUE
C
XSIZBIN = (MAXX/5.0)
YSIZBIN = (MAXY/4.0)
C
C---- Search for the strongest full spot in each
C subdivision of the film
C
DO 40 I = 1,TOSPT
C
C---- Reject partials and rejected spots
C
IR = IRG(I)
IM = IMG(I)
C
C---- But if PARTLS set only reject "rejected" spots
C
IF (PARTLS) THEN
IF (IR.LT.IR1) GO TO 40
ELSE
IF ((IR.NE.0).OR.(IM.NE.0)) GO TO 40
END IF
C
C
C---- Reject overloads or unmeasured spots on preceeding film
C
INT = INTG(I)
C
C
IF (DEBUG(13).AND.NDBG.LT.NDEBUG(13)) THEN
NDBG = NDBG + 1
WRITE(IOUT,FMT=6026) I,INTG(I),ISDG(I)
IF (ONLINE) WRITE(ITOUT,FMT=6026) I,INTG(I),ISDG(I)
6026 FORMAT(1X,'Reflection',I6,' Intensity',I8,' sigma',I8)
END IF
IF (INT.NE.9999 .AND. INT.GT.0) THEN
XC = XG(I)
YC = YG(I)
K = (MAXX+XC)/XSIZBIN
IF (K.GT.9) K = 9
J = (MAXY+YC)/YSIZBIN
IF (J.LT.1) J = 1
IF (J.GT.6) J = 6
INDX = 6*K + J
ISDR = INT/ISDG(I)
C
C
IF (ISDR.GE.ISPOT(INDX)) THEN
C
C
IF (DEBUG(13).AND.NDBG.LT.NDEBUG(13)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) I,XG(I),YG(I),ISDR
6000 FORMAT (1X,'Reflection',I5,' IX,IY',2F8.1,' ISDR',I5)
WRITE (IOUT,FMT=6000) I,XG(I),YG(I),ISDR
END IF
C
C
ISPOT(INDX) = ISDR
IRECNO(INDX) = I
C
C
IF (PRECESS) THEN
C
C ************************
CALL PXYCALC(XCAL,YCAL,XC,YC)
C ************************
C
ELSE
C
C ***********************
CALL MMTOPX(XCAL,YCAL,XC,YC)
C ***********************
C
END IF
C
C
X(INDX) = NINT(XCAL*FACT)
Y(INDX) = NINT(YCAL*FACT)
END IF
END IF
cc?? end if
40 CONTINUE
C
C---- Count number of spots found and reject those with
C I/SD.LT.NSDR (DEFAULTS TO 8)
C
IF (DEBUG(13)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6002)
6002 FORMAT (//1X,'Selected reflections in NEXT')
WRITE (IOUT,FMT=6002)
END IF
C
C
50 CONTINUE
NREF = 0
C
C
DO 60 I = 1,60
C
C---- NSDR set by default to 8, may be changed by keyword isdr
C
IF (ISPOT(I).GE.NSDR) THEN
C
C---- Check that the whole measurement box lies within scanned area.
C Assume max possible box size for this test (as in GENSORT)
C
IF (X(I).LT.XLOW .OR. X(I).GT.XHIGH .OR.
+ Y(I).LT.YLOW .OR. Y(I).GT.YHIGH) GO TO 60
C
C
NREF = NREF + 1
Y(NREF) = Y(I)
IRECNO(NREF) = IRECNO(I)
X(NREF) = X(I)
C
C
IF (DEBUG(13)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6004) NREF,X(I),Y(I)
6004 FORMAT (1X,'NREF=',I5,' X,Y',2I6)
WRITE (IOUT,FMT=6004) NREF,X(I),Y(I)
END IF
C
C
END IF
60 CONTINUE
C
C
C
C---- Check we have a reasonable number of reflections
C if not, reduce the ratio to two-thirds of current value
C (and keep it at this for otherfilms). set a minimum of 2.
C
IF (NREF.LT.20) THEN
C
IF (NSDR.GE.2) THEN
NSDRP = NINT(0.6667*NSDR)
IF (ONLINE) WRITE (ITOUT,FMT=6008) NREF,NSDR,NSDRP
6008 FORMAT (//1X,'***** ONLY',I3,' Reflections found with intensity ',
+ 'greater than',I3,' Sigma ****',/1X,'Ratio reduced to ',I3)
WRITE (IOUT,FMT=6008) NREF,NSDR,NSDRP
NSDR = NSDRP
GO TO 50
ELSE
WRITE (IOUT,FMT=6006) NREF,NSDR
6006 FORMAT (//1X,'***** ONLY',I3,' Reflections found with intensity ',
+ 'greater than',I3,' Sigma ****',/1X,'Abandon processing',
+ ' of this film')
IF (ONLINE) WRITE (ITOUT,FMT=6006) NREF,NSDR
IFAIL = -1
RETURN
END IF
C
C
ELSE
GO TO 70
END IF
C
C---- End of "IF LIST" block
C
END IF
C
C---- Find reflections
C
70 WRITE (IOUT,FMT=6010) NREF
6010 FORMAT (I6,' Spots to be measured')
IF (ONLINE) WRITE (ITOUT,FMT=6010) NREF
C
C **********************
CALL SORTUP3(NREF,X,Y,IRECNO)
C **********************
C
C---- Set up variable rasters
C
DO 80 I = 1,NREF
C
C---- Get the raster parameters and box number for this reflection
C
IXPIX = X(I)
IYPIX = Y(I)
C ***********************************
CALL GETBOX(IXPIX,IYPIX,NXX,NYY,NPBOX)
C ***********************************
IHWX = NXX/2
HWX(I) = IHWX
HWY(I) = NYY/2
IWX(I) = IHWX*2 + 1
C
C---- Add in measurement box shift
C
X(I) = X(I) + IXSHIFT
Y(I) = Y(I) + IYSHIFT
80 CONTINUE
C
C
MAXB = MAXR
IF (IMGP) THEN
MAXW = MAXB
ELSE
MAXW = (MAXB+1)/2
MAXB = 2*MAXW
END IF
MAXN = 0.5*MAXBUFF/MAXW
C
INDF = 1
INDL = 1
IFRST = 1
ILAST = 0
FULL = .FALSE.
90 CONTINUE
C
C---- Get the start of the raster for the first spot or
C for a spot after a gap
C
IBLK = X(INDF) - HWX(INDF)
100 CONTINUE
C
C---- Check if trying to read outside limits of image. This can happen if
C there has been a large shift in the refined parameters. If true,
C simply reset IBLK to max/min allowed value.
C
IF ((IBLK.LT.XSCMIN).OR.(IBLK.GT.XSCMAX)) THEN
IF (IBLK.LT.XSCMIN) IBLK = XSCMIN
IF (IBLK.GT.XSCMAX) IBLK = XSCMAX
WRITE(6,*)'In NEXT IBLK,INDF,X,HWX',IBLK,INDF,X(INDF),HWX(INDF)
END IF
C ****************
CALL RDBLK(IBLK)
C ****************
C
110 CONTINUE
C
C
IF (INDL.NE.NREF) THEN
IF (.NOT.FULL) THEN
C
C---- See if next reflection has become active
C
MINDL = INDL + 1
C
C
IF (IBLK.GE.X(MINDL)-HWX(MINDL)) THEN
INDL = INDL + 1
IF (INDL-INDF.EQ.MAXN-1) FULL = .TRUE.
GO TO 110
END IF
END IF
END IF
C
C---- Get results from this scan and start the next one
C
IBLK = IBLK + 1
C
C---- Store optical densities for all spots included in this scan
C the ods are transferred to iarr in call to bswap
C
IF (INDL.GE.INDF) THEN
C
C
DO 120 J = INDF,INDL
C
C---- MJ is pointer for reflection J, range 1 to MAXN
C
MJ = MOD(J-1,MAXN) + 1
IYPIX = Y(J)
KMN = IYPIX - HWY(J)
KMX = HWY(J) + IYPIX
C
C
IF (J.EQ.IFRST) THEN
C
C---- If this reflection has just started,
C set byte pointer (PNTR) into BB.
C
C---- NJ is byte pointer to start address for reflection J (MJ)
C
C---- PNTR(J) gives current address in BB for relection J (MJ)
C
NJ = (MJ-1)*MAXB
PNTR(MJ) = NJ + 1
IFRST = IFRST + 1
END IF
C
C
IADDR = PNTR(MJ)
C
C ********************
CALL BSWAP(KMN,KMX,IADDR)
C ********************
C
C---- Add in second part for summed partials
C
IF (ADDPART.AND.(IRECNO(J).LT.0)) THEN
C
C Reset IADDR (incremented in BSWAP)
IADDR = IADDR - (KMX - KMN + 1)
C *******************
CALL BSWAP2(KMN,KMX,IADDR)
C *******************
END IF
C
C---- update pointer PNTR(MJ). Note IADDR is incremented in BSWAP
C
PNTR(MJ) = IADDR
IWX(J) = IWX(J) - 1
120 CONTINUE
END IF
C
C
130 CONTINUE
C
C---- Check if one or more spots are finished
C
IF (IWX(INDF).EQ.0) THEN
IND = ILAST*MAXW + 1
ILAST = ILAST + 1
NXX = HWX(INDF)*2 + 1
NYY = HWY(INDF)*2 + 1
C
C
C
C
C---- Extract degree of partiality for CGFIT
C
II = IRECNO(INDF)
IF (II.LT.0) II = -II
IPART = IMG(II)
IF (ADDPART) IPART = 0
IF (DEBUG(13)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6016) X(INDF)/FACT,Y(INDF)/FACT,
+ IRECNO(INDF),LRAS,IPART
WRITE (IOUT,FMT=6016) X(INDF)/FACT,Y(INDF)/FACT,IRECNO(INDF),
+ LRAS,IPART
END IF
6016 FORMAT (//1X,'Find C of G for XRS,YRS (10 MU)',2F8.1,' Genfile',
+ ' record no',I5,/,1X,'Raster parameters',5I6, ' IPART',I4)
C
C *************************************
CALL CGFIT(IARR(IND),LRAS,1,DELX,DELY,SOD,SDELX,SDELY,
+ IPART,IFLAG)
C *************************************
C
C
C---- Reject reflections with too steep gradient
C
IF (IFLAG.EQ.1) THEN
NBGBADG = NBGBADG + 1
GOTO 145
END IF
C---- Reject reflections with too many background points rejected
C (only tested with CGFIT)
IF (IFLAG.EQ.2) THEN
NBGBAD = NBGBAD + 1
GOTO 145
END IF
C
C---- Reject reflections containing zero value pixels (outside scanned
C area)
IF (IFLAG.EQ.3) THEN
NZPBAD = NZPBAD + 1
GOTO 145
END IF
C
C---- Check for overloads. This should never
C happen when processing a 'B' or 'C' film
C since reflection list has been chosen
C on basis of previous film in the pack, but when 'NEXT' is
C called with a list of reflections from the central region
C of the film if the initial residual was high then previously
C spots which were not overloads can become overloads.
C
C---- Also, if using AUTOMATCH, overloaded reflections are allowed
C when running CENTRS, and some of these may be selected when
C the entire film refinement is done. In this case the parameters
C should be well enough determined by the spots from the outer
C region of the film, so rejecting a few from the inner region
C shouldn't hurt.
C
IF (IFLAG.EQ.4) THEN
NROVR = NROVR + 1
ELSE
C
NRS = NRS + 1
XRS(NRS) = (X(INDF)+DELX)/FACT
YRS(NRS) = (Y(INDF)+DELY)/FACT
RRS(NRS) = IRECNO(INDF)
WXRS(NRS) = SDELX/FACT
WYRS(NRS) = SDELY/FACT
C
C
IF (DEBUG(13)) THEN
SHX = (DELX+IXSHIFT)/FACT + 0.5
SHY = (DELY+IYSHIFT)/FACT + 0.5
WRITE (IOUT,FMT=6012) INDF,X(INDF),Y(INDF),NXX,NYY,
+ SHX,SHY,SOD,SDELX/FACT,SDELY/FACT
IF (ONLINE) WRITE (ITOUT,FMT=6012) INDF,X(INDF),
+ Y(INDF),NXX,NYY,SHX,SHY,SOD,SDELX/FACT,SDELY/FACT
IF (SPOT) CALL ODPLOT(IARR(IND),NXX,NYY,1)
END IF
6012 FORMAT (1X,'INDF=',I3,' IX,IY',2I6,3X,'NX,NY',2I4,
+ ' C OF G. SHIFTS',2I6,' SOD',F8.0,' SIGX,SIGY',2F7.2)
C
C---- Store indices if pattern matching
C
IF (MATCH) THEN
JREC = IRECNO(INDF)
IF (JREC.LT.0) JREC = -JREC
C
C
IHKLR(1,NRS) = IHG(JREC)
IHKLR(2,NRS) = IKG(JREC)
IHKLR(3,NRS) = ILG(JREC)
C
C
END IF
END IF
C
C
145 IF (ILAST.EQ.MAXN) ILAST = 0
INDF = INDF + 1
C
C
IF (INDF.LE.NREF) THEN
GO TO 130
ELSE
GO TO 150
END IF
END IF
C
C
IF (INDF.LE.INDL) GO TO 100
FULL = .FALSE.
GO TO 90
CAL* 150 IF (LIST) NRS = NRSOLD
150 CONTINUE
C
C
IF (NROVR.NE.0) THEN
NWRN = NWRN + 1
WRITE (IOUT,FMT=6018) NROVR
6018 FORMAT (/1X,'**** WARNING ****',/1X,I3,' OVERLOADS in spot refin',
+ 'ement list have been rejected')
IF (ONLINE) WRITE (ITOUT,FMT=6018) NROVR
END IF
IF (NBGBAD.NE.0) THEN
WRITE (IOUT,FMT=6020) NBGBAD,BGFREJ
6020 FORMAT (//1X,I3,' reflections rejected because more than a ',
1 'fraction',F5.2,' of the background pixels were rejected')
IF (ONLINE) WRITE (ITOUT,FMT=6020) NBGBAD,BGFREJ
END IF
IF (NBGBADG.NE.0) THEN
WRITE (IOUT,FMT=6022) NBGBADG,GRADMAXR
6022 FORMAT (//1X,I3,' reflections rejected because the gradient',
1 '/(average background) is greater then',F6.3)
IF (ONLINE) WRITE (ITOUT,FMT=6022) NBGBADG,GRADMAXR
END IF
IF (NZPBAD.GT.0) THEN
IF (CENTRAL) WARN(14) = .TRUE.
WRITE (IOUT,FMT=6024) NZPBAD,NULLPIX
6024 FORMAT (//1X,I3
$ ,' reflections have been rejected because the '
$ ,' measurement box contains',/,1X
$ ,'pixels with values less or equal to',I5,
+ ' (assumed to '
$ ,'be outside the scanned area).',/,1X,
+ 'See warning at end of logfile or in summary file.')
IF (ONLINE) WRITE (ITOUT,FMT=6024) NZPBAD,NULLPIX
END IF
END
C== NOYES ==
C
C
C
SUBROUTINE NOYES(I1,I2)
C =======================
C
C
C
C
C .. Scalar Arguments ..
INTEGER I2
CHARACTER I1*1
C ..
C
C
I2 = 0
IF (I1.EQ.'Y') I2 = 1
IF (I1.EQ.'y') I2 = 1
IF (I1.EQ.'N') I2 = 0
IF (I1.EQ.'n') I2 = 0
C
C
END
C== ODPLOT ==
SUBROUTINE ODPLOT(BB,IWX,IWY,IDR)
C =================================
C
C
C
C---- Plots array of pixel values for spot on
C tektronix.Pixel values are stored in a byte array for film data
C Called by CENTRS,SEEKRS,MEAS,NEXT for optional output of spots
C
C
C
C---- 12/9/81 Change IODDUMP to I*4 from I*2, and calls to BEXPAN to BEXPAN4
C to cope with dynamic range up to 64K
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
INTEGER IDR,IWX,IWY
C ..
C .. Array Arguments ..
INTEGER*2 BB(*)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,N,NXY,MAXPIX
C ..
C .. Local Arrays ..
INTEGER IODDUMP(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL BEXPAN4
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
SAVE
C ..
C
NXY = IWX*IWY
N = NXY
IF (IDR.EQ.1) N = IWY
C
C *****************************
CALL BEXPAN4(BB,IODDUMP,NXY)
C *****************************
C
C---- Now call ODPLOT4 to plot this
C
MAXPIX = 0
CALL ODPLOT4(IODDUMP,IWX,IWY,IDR,MAXPIX)
C
END
C== ODPLOT4 ==
SUBROUTINE ODPLOT4(BB,IWX,IWY,IDR,MAXPIX)
C =========================================
C
C
C
C---- Plots array of pixel values for spot on
C tektronix.Pixel values are stored in an I*4 array
C Called by CENTRS,SEEKRS,MEAS,NEXT,PROCESS for optional output of spots
C
C MAXPIX If passed in as non-zero, use this value to determine
C format for printing pixel values. Not updated.
C
C If passed in as zero, returned as maximum pixel value.
C
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
INTEGER IDR,IWX,IWY,MAXPIX
C ..
C .. Array Arguments ..
INTEGER*4 BB(*)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,N,NXY
C ..
C .. Local Arrays ..
INTEGER IA(40)
C ..
C .. External Subroutines ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
SAVE
C ..
C
C---- Find maximum value in BB to determine printing format, unless
C MAXPIX is passed in as non-zero, in which case use passed value.
C
NXY = IWX*IWY
C
IF (MAXPIX.EQ.0) THEN
DO 2 I = 1,NXY
IF (BB(I).GT.MAXPIX) MAXPIX = BB(I)
2 CONTINUE
END IF
C
N = NXY
IF (IDR.EQ.1) N = IWY
C
DO 20 J = 1,IWY
IJ = N - J + 1
C
C
DO 10 I = 1,IWX
IA(I) = BB(IJ)
IJ = IDR*IWY + IJ
10 CONTINUE
C
C
IF (MAXPIX.LT.100) THEN
WRITE (IOUT,FMT=6020) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6020) (IA(K),K=1,IWX)
ELSE IF (MAXPIX.LT.1000) THEN
WRITE (IOUT,FMT=6000) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6000) (IA(K),K=1,IWX)
ELSE IF (MAXPIX.LT.10000) THEN
WRITE (IOUT,FMT=6001) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6001) (IA(K),K=1,IWX)
ELSE IF (MAXPIX.LT.100000) THEN
WRITE (IOUT,FMT=6002) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6002) (IA(K),K=1,IWX)
ELSE IF (MAXPIX.LT.1000000) THEN
WRITE (IOUT,FMT=6004) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6004) (IA(K),K=1,IWX)
ELSE IF (MAXPIX.LT.10000000) THEN
WRITE (IOUT,FMT=6006) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6006) (IA(K),K=1,IWX)
ELSE
WRITE (IOUT,FMT=6008) (IA(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6008) (IA(K),K=1,IWX)
END IF
20 CONTINUE
C
C---- Format statements
C
6020 FORMAT (1X,30I3)
6000 FORMAT (1X,30I4)
6001 FORMAT (1X,26I5)
6002 FORMAT (1X,21I6)
6004 FORMAT (1X,18I7)
6006 FORMAT (1X,16I8)
6008 FORMAT (1X,13I10)
C
C
END
C== ODPLOT4R ==
SUBROUTINE ODPLOT4R(BB,IWX,IWY,IDR,MASK,MASKREJ,MASKREJP,
+ LMASKREJP,MAXPIX)
C ================================================================
C
IMPLICIT NONE
C
C
C---- Plots array of pixel values for spot, with rejected backgorund pixels
C flagged by a "minus" sign. Based on ODPLOT4.
C Pixel values are stored in an I*4 array
C Called by PROCESS for optional output of spots
C
C MASKREJO Array containing list of rejected background pixels
C because they are outliers. This is set up in EVAL
C and passed back to PROCESS.
C
C MASKREJP Array containing list of rejected peak pixels
C due to overlap of neighbouring spots (from MASKIT).
C This is unchanged.
C
C LMASKREJP Array containing list of rejected peak pixels
C due to very poor profile fit. This is set up in this
C INTEG2 and passed back to PROCESS.
C
C
C
C MAXPIX If passed in as non-zero, use this value to determine
C format for printing pixel values. Not updated.
C
C If passed in as zero, returned as maximum pixel value.
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
INTEGER IDR,IWX,IWY,MAXPIX
C ..
C .. Array Arguments ..
INTEGER BB(MAXBOX),MASKREJ(NREJMAX),MASK(MAXBOX),
+ MASKREJP(NREJMAX),LMASKREJP(NREJMAX)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,N,NXY,NREJ
C ..
C .. Local Arrays ..
INTEGER IA(40)
INTEGER*2 IREJ(MAXBOX)
CHARACTER*1 FLAG(40)
C ..
C .. External Subroutines ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
SAVE
C ..
C
C
C---- Find maximum value in BB to determine printing format, but only
C if MAXPIX is passed in as zero, otherwise used passed value.
C
NXY = IWX*IWY
C
IF (MAXPIX.EQ.0) THEN
DO 2 I = 1,NXY
IREJ(I) = 0
IF (BB(I).GT.MAXPIX) MAXPIX = BB(I)
2 CONTINUE
ELSE
DO 3 I = 1,NXY
IREJ(I) = 0
3 CONTINUE
END IF
C
C---- Set flag for all rejected pixels
C
NREJ = MASKREJ(1)
IF (NREJ.GT.0) THEN
DO 4 I = 1,NREJ
IJ = MASKREJ(I+1)
IREJ(IJ) = 1
4 CONTINUE
END IF
C
C---- Now rejected peak pixels
C
NREJ = MASKREJP(1)
IF (NREJ.GT.0) THEN
DO 6 I = 1,NREJ
IJ = MASKREJP(I+1)
IREJ(IJ) = 2
6 CONTINUE
END IF
C
C---- Now rejected peak pixels due to poor profile fit
C
NREJ = LMASKREJP(1)
IF (NREJ.GT.0) THEN
DO 8 I = 1,NREJ
IJ = LMASKREJP(I+1)
IREJ(IJ) = 3
8 CONTINUE
END IF
C
N = NXY
IF (IDR.EQ.1) N = IWY
WRITE(IOUT,FMT=6020)
IF (ONLINE) WRITE(ITOUT,FMT=6020)
6020 FORMAT(1X,'Dump of pixel values, X across page, Y up page',
+ ' origin at lower left',/,
+ 1X,'Flagged pixels are indicated by a symbol immediately ',
+ 'following the pixel value. The flags are:',/,1X,
+ 1X,'Background pixels "-", rejected background due to spot ',
+ 'overlap "*", rejected as outliers "$"',/,1X,
+ 'Rejected peak pixels due to peak overlap "+" ',
+ 'Rejected peak pixels due to poor profile fit "&"')
C
DO 20 J = 1,IWY
IJ = N - J + 1
C
C
DO 10 I = 1,IWX
IA(I) = BB(IJ)
C
C---- See if this is rejected
C
IF (MASK(IJ).GT.0) THEN
FLAG(I) = ' '
ELSE IF (MASK(IJ).LT.0) THEN
FLAG(I) = '-'
ELSE
FLAG(I) = '*'
END IF
IF (IREJ(IJ).EQ.1) FLAG(I) = '$'
IF (IREJ(IJ).EQ.2) FLAG(I) = '+'
IF (IREJ(IJ).EQ.3) FLAG(I) = '&'
IJ = IDR*IWY + IJ
10 CONTINUE
C
C
IF (MAXPIX.LT.1000) THEN
WRITE (IOUT,FMT=6000) (IA(K),FLAG(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6000) (IA(K),FLAG(K),K=1,IWX)
ELSE IF (MAXPIX.LT.10000) THEN
WRITE (IOUT,FMT=6001) (IA(K),FLAG(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6001) (IA(K),FLAG(K),K=1,IWX)
ELSE IF (MAXPIX.LT.100000) THEN
WRITE (IOUT,FMT=6002) (IA(K),FLAG(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6002) (IA(K),FLAG(K),K=1,IWX)
ELSE IF (MAXPIX.LT.1000000) THEN
WRITE (IOUT,FMT=6004) (IA(K),FLAG(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6004) (IA(K),FLAG(K),K=1,IWX)
ELSE IF (MAXPIX.LT.10000000) THEN
WRITE (IOUT,FMT=6006) (IA(K),FLAG(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6006) (IA(K),FLAG(K),K=1,IWX)
ELSE
WRITE (IOUT,FMT=6008) (IA(K),FLAG(K),K=1,IWX)
IF (ONLINE) WRITE (ITOUT,FMT=6008) (IA(K),FLAG(K),K=1,IWX)
END IF
20 CONTINUE
C
C---- Format statements
C
6000 FORMAT (1X,30(I3,A))
6001 FORMAT (1X,26(I4,A))
6002 FORMAT (1X,21(I5,A))
6004 FORMAT (1X,18(I6,A))
6006 FORMAT (1X,16(I7,A))
6008 FORMAT (1X,13(I9,A))
C
C
END
C== OPENODS ==
SUBROUTINE OPENODS(IDENT,ID,NFIRSTI,ODEXT,FDISK,MODEOP,
+ PACK,ODFILE,SEPCHAR,FORCEREAD,IPACK,
+ TEMPLSTART,TEMPLEND)
C ===============================================================
C
IMPLICIT NONE
C
C---- Opens the file of optical densities and positions file
C at ods of the first film to be processed.
C If the image is to be stored in memory, all the image is
C read.
C ***** IMPORTANT *****
C Because image plate image files are sequential rather than
C direct access, the image MUST be read into memory !!!
C
C If partials from adjacent images are to be summed (SUMPART)
C the first call to OPENODS must also open and store the second
C image, and subsequent calls will open and store the following
C image rather than the one currently being processed (because it
C will already be in memory). The pointer ISTART is used to keep
C track of where the first stripe of data for the image currently
C being processed is stored in array IMAGE. Thus ISTART has values
C of 0 or NREC.
C
C
C ID Image number.
C If the file does not exist, ID is returned as -999
C If error in read, ID is returned as -1001
C If error in decoding header, ID is returned as -1002
C
C MODEOP = 1 If this is the first image to be stored, so that if
C using SUMPART or POSTREF two images have to be read in
C This will be true after each RUN card OR when doing a
C "REPEAT" run because of a large shift in the first
C post-refinement.
C It is reset to zero in this subroutine
C
C = 0 Normal mode
C
C = 2 When image file is opened ONLY to get image size (called
C from CONTROL).
C
C = 3 When reading in images for display after integration.
C In this case all images should be read into the same
C part of array IMAGE (ie IADD should not be changed)
C
C PACK (Returned) TRUE if this is a "packed" image file
C
C SEPCHAR The separator between the text (IDENT) and number part
C of the image filename. Must be "_" or "-".
C
C FORCEREAD Forces image to be read even if image filename matches
C name of image stored. Needed to read in image after the
C IMAGE array has been used as work space.
C
C IPACK If non-zero, and either ISTRT or IANGLE are zero (ie start
C phi or oscillation angle have not been given) then phi
C values from the image header are stored in arrays
C PHIBEGA, PHIENDA
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER ID,NFIRSTI,MODEOP,IPACK
CHARACTER IDENT*(*),ODEXT*8,FDISK(10)*80,ODFILE*200,SEPCHAR*1,
+ TEMPLSTART*(*),TEMPLEND*(*)
LOGICAL PACK,FORCEREAD
C ..
C .. Local Scalars ..
INTEGER I,NCH,NCHFULL,LNDSK,IBLK,IDTMP,NCH2,IADD,IREC,IBYTES,
+ NCMITM,IST,IJ,J,IBEG,IEND,NSTRIPE,K,IND1,IND2,
+ NXPIX,NYPIX,NRECOVFL,IOD,NOVFL,ISWAP,ITIME,
+ NTRY,NNDIR,IERR,I1,I2,NTIMES,NCHAR,IFLAG,ISTAT,
$ PIXMIN,PIXMAX,XMIN,XMAX,YMIN,YMAX,ZOOM,ifilesize
LOGICAL EFILE,LOGDSK,FIRST_TIME,ADDALL,FIRSTONE,SAVETIT,FIRSTSWAP
CHARACTER STR*3,FULLFN*200,IDENTT*80,HANDLE*5,
+ STITLE*200
C ..
C .. Local Arrays ..
INTEGER IFILENAM(200),INFO(3)
CHARACTER ABC(3)*1,STORIMG(2)*200
C ..
C .. External Functions ..
LOGICAL VAXVMS,LITEND
INTEGER LENSTR
EXTERNAL LENSTR,VAXVMS,LITEND
C ..
C .. External Subroutines ..
EXTERNAL CCPLWC,QOPEN,QCLOSE,QMODE,GETBLK,GETHDR,READPACK_WORD,
+ IMSIZ,GETOVR,IMGINV,MSLEEP,MXDBSY,XDLF_FLUSH_EVENTS,
+ GETTAIL,OPENFILE,TEMPLMAKE
C ..
C .. Common blocks ..
C&&*&& include ../inc/cbfinc.f
C
C---- The following are used for transferring values between the C stuff
C and Fortran for CBF images (see wrapper.f for assignments)
C
DOUBLE PRECISION CBF_DOUBLE(16)
INTEGER*4 CBF_INT4(16)
INTEGER CBF_INT(16)
CHARACTER*24 CBF_CHAR(16)
LOGICAL CBF_LOG(16)
COMMON /CBF_PAR/ CBF_DOUBLE,CBF_INT4,CBF_INT,CBF_CHAR,CBF_LOG
C&&*&& end_include ../inc/cbfinc.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/praccum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file praccum.h
C---- START of include file praccum.h
C
C
C ..
C .. Arrays in common block /PRACCUM/ ..
REAL PRDATA
C
C .. Scalars in common block /PRACCUM/ ..
LOGICAL ACCUMULATE,FIRSTPASS,SECONDPASS,THIRDPASS,FIRSTFILM,
+ NOTREAD
C ..
C .. Common Block /PRACCUM/ ..
COMMON /PRACCUM/PRDATA(4,50),ACCUMULATE,FIRSTPASS,SECONDPASS,
+ THIRDPASS,FIRSTFILM,NOTREAD
C ..
C
C
C&&*&& end_include ../inc/praccum.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
SAVE
C ..
C .. Data statements ..Move ISTART to MOSDATA
DATA ABC/'a','b','c'/
DATA FIRSTONE/.TRUE./,SAVETIT/.FALSE./
DATA STORIMG/' ',' '/
C ..
C
C---- Set flag if a constant is to be added to all pixel values
C
ADDALL = (ICONST.NE.0)
C
C---- Allow byte swapping in GETBLK
C
ISWAP = 0
NTRY = 0
NNDIR = 1
C
C---- Assign FIRST_TIME on basis of MODEOP
C
FIRST_TIME = ((MODEOP.EQ.1).OR.(MODEOP.EQ.2))
IF (FIRST_TIME) IADD = 0
C---- Get Film area disk storage area
C
LOGDSK = .FALSE.
FIRSTSWAP = .TRUE.
C
IF (FDISK(1).EQ.' ') THEN
C
C---- files must be in current working directory
C
LOGDSK = .FALSE.
ELSE
LOGDSK = .TRUE.
LNDSK = LENSTR(FDISK(NNDIR))
END IF
C
C---- Find how many non-blank characters in ident
C
IF (.NOT.TEMPLATE) THEN
NCH = LENSTR(IDENT)
IDENTT = IDENT(1:NCH)//SEPCHAR
NCH = NCH +1
NCH2 = LENSTR(ODEXT)
END IF
C
IDTMP = ID
C
C---- Initialise ISTART...has to be set to NREC because on reading the
C second image it will be reset to 0.
C
IF (SUMPART.AND.FIRST_TIME) ISTART = NREC
C
C---- Return to this point if reading second image
C in order to add partials
C
10 IF (SUMPART.AND.(.NOT.FIRST_TIME)) THEN
C
C---- set display filename to the PREVIOUS image that was read in.
C
CDSPTL = ODFILE
IF ((MODEOP.EQ.3).AND.(FIRSTONE)) THEN
FIRSTONE = .FALSE.
STITLE = ODFILE
SAVETIT = .TRUE.
END IF
IF ((MODEOP.NE.3).AND.(SAVETIT)) THEN
CDSPTL = STITLE
SAVETIT = .FALSE.
END IF
C
IDTMP = ID + 1
C
C---- If displaying after integration, do NOT update ISTART
C
IF (MODEOP.NE.3) THEN
IF (ISTART.EQ.0) THEN
ISTART = NREC
ELSE IF (ISTART.EQ.NREC) THEN
ISTART = 0
END IF
END IF
END IF
C
WRITE (STR,FMT=6000) IDTMP
C
C
C---- If only one image/film per file (eg DLAB or LMB or image plate)
C
12 IF (ONEFILE) THEN
C
IF (IMGP) THEN
C
C---- No pack identifier for image plate data
C
IF (LOGDSK) THEN
IF (TEMPLATE) THEN
CALL TEMPLMAKE(TEMPLSTART,TEMPLEND,NTDIG,IDTMP,ODFILE,
+ IFLAG)
IF (IFLAG.NE.0) THEN
WRITE(IOUT,FMT=6030) IDTMP
IF (ONLINE) WRITE(ITOUT,FMT=6030) IDTMP
6030 FORMAT(1X,'***** ERROR *****',/,1X,'Image number',
+ I8,' is not compatable with supplied TEMPLATE',/,1X,
+ 'which only allows',I3,' digits.')
ID = -999
RETURN
END IF
ODFILE = FDISK(NNDIR)(1:LNDSK)//ODFILE(1:LENSTR(ODFILE))
ELSE
ODFILE = FDISK(NNDIR)(1:LNDSK)//IDENTT(1:NCH)//STR//
+ '.'//ODEXT(1:NCH2)
END IF
ELSE
IF (TEMPLATE) THEN
CALL TEMPLMAKE(TEMPLSTART,TEMPLEND,NTDIG,IDTMP,ODFILE,
+ IFLAG)
IF (IFLAG.NE.0) THEN
WRITE(IOUT,FMT=6030) IDTMP
IF (ONLINE) WRITE(ITOUT,FMT=6030) IDTMP
ID = -999
RETURN
END IF
ELSE
ODFILE = IDENTT(1:NCH)//STR//'.'//
+ ODEXT(1:NCH2)
END IF
END IF
ELSE
C
C---- For films include pack identifier
C
IF (LOGDSK) THEN
ODFILE = FDISK(NNDIR)(1:LNDSK)//IDENTT(1:NCH)//STR//
+ ABC(NFIRSTI)//'.'//ODEXT(1:NCH2)
ELSE
ODFILE = IDENTT(1:NCH)//STR//
+ ABC(NFIRSTI)//'.'//ODEXT(1:NCH2)
END IF
END IF
C
C---- 3 film pack in one file (Imperial)
C
ELSE
C
C
IF (LOGDSK) THEN
ODFILE = FDISK(NNDIR)(1:LNDSK)//IDENTT(1:NCH)//
+ STR//'.'//ODEXT(1:NCH2)
ELSE
ODFILE = IDENTT(1:NCH)//STR//'.'//ODEXT(1:NCH2)
END IF
C
C
END IF
C
C---- Test if file exists
C
INQUIRE (FILE=ODFILE,EXIST=EFILE,NAME=FULLFN)
C
C---- If file does not exist, try another file directory (if more than one
C has been given)
C
IF (.NOT.EFILE) THEN
NNDIR = NNDIR + 1
IF (FDISK(NNDIR).NE.' ') THEN
LNDSK = LENSTR(FDISK(NNDIR))
GOTO 12
END IF
END IF
C
C---- Set up title for X-windows display
C
IF ((.NOT.SUMPART).OR.FIRST_TIME.OR.(MODEOP.EQ.3))
+ CDSPTL = ODFILE
C
C---- Find how many non-blank characters in fullfn
C
NCHFULL = LENSTR(FULLFN)
IF (MODEOP.NE.2) THEN
WRITE (IOUT,FMT=6002) FULLFN(1:NCHFULL)
IF (ONLINE) WRITE (ITOUT,FMT=6002) FULLFN(1:NCHFULL)
END IF
C
C---- Test if this is a packed file
C
NCHAR = LENSTR(ODEXT)
C
C---- only set PACK true if extension is "pck" and not "pck1200" etc
C
PACK = (((ODEXT(1:3).EQ.'PCK').OR.(ODEXT(1:3).EQ.'pck')).AND.
+ (NCHAR.EQ.3))
IF (PACK) THEN
IF (MODEOP.NE.2) THEN
WRITE(IOUT,FMT=6006)
IF (ONLINE) WRITE(ITOUT,FMT=6006)
END IF
END IF
C
C
C---- If a non zero wait time has been given, wait for an interval
C determined from the wait period, then try again; for compatibility
C with previous version, actually do this for twice the waiting period
C
IF (.NOT.EFILE.AND.(WAIT.NE.0.0)) THEN
ITIME = MIN(5,INT(WAIT/10))
NTIMES = 2*(WAIT/ITIME)
WRITE(IOUT,FMT=6020)
IF (ONLINE ) WRITE(ITOUT,FMT=6020)
6020 FORMAT(/,1X,'Waiting for image to be ready')
I = 1
DO 13 WHILE ((I.LE.NTIMES).AND.(.NOT.EFILE))
INQUIRE (FILE=ODFILE,EXIST=EFILE,NAME=FULLFN)
IF(.NOT.EFILE)THEN
CALL MSLEEP(ITIME)
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(J)
I = I + 1
ELSE
I = NTIMES + 1
NTRY = 2
ENDIF
IF(I.EQ.NTIMES/2)THEN
WRITE(IOUT,FMT=6020)
IF (ONLINE ) WRITE(ITOUT,FMT=6020)
ENDIF
13 ENDDO
C
C---- give the file time to finish being written if it's appeared just before
C above INQUIRE
C
CALL MSLEEP(MAX(DELAY,ITIME*2))
END IF
C
IF (.NOT. EFILE) THEN
FULLFN = ODFILE
IF (SUMPART.AND.(.NOT.FIRST_TIME)) THEN
C
C---- If the second image for summing partials doesn't exist, set
C SUMPART false and return
C
WRITE(IOUT,6003) FULLFN(1:NCHFULL)
IF (ONLINE) WRITE(ITOUT,6003) FULLFN(1:NCHFULL)
SUMPART = .FALSE.
FORCEREAD = .FALSE.
C
C---- This is fatal if doing a multiseg post refinement
C
IF (MULTISEG) ID = -999
RETURN
ELSE
IF (MODEOP.EQ.2) THEN
WRITE (IOUT,FMT=6005) FULLFN(1:NCHFULL)
IF (ONLINE) WRITE (ITOUT,FMT=6005) FULLFN(1:NCHFULL)
ELSE
WRITE (IOUT,FMT=6004) FULLFN(1:NCHFULL)
IF (ONLINE) WRITE (ITOUT,FMT=6004) FULLFN(1:NCHFULL)
END IF
ID = -999
FORCEREAD = .FALSE.
RETURN
END IF
END IF
C
C---- Now open the file. Film images are stored as direct access files,
C but image plate images are sequential unformatted files, so need
C different OPEN statements
C
C DO NOT open the file yet if it is a packed file.
C
IF (PACK) GOTO 16
C
C---- If this is a "tif" format file, read it with a separate routine
C
IF (MACHINE.EQ.'CCD1') THEN
C
C---- If summing partials, two images are held in memory at any
C one time and we must set a pointer to read the next image
C into the appropriate part of image.
IF (SUMPART.AND.(.NOT.FIRST_TIME)) THEN
IF (MODEOP.NE.3) THEN
IF (ISTART.EQ.0) IADD = NREC
IF (ISTART.EQ.NREC) IADD = 0
ELSE
IADD = ISTART
END IF
END IF
IF (DEBUG(45)) THEN
I1 = LENSTR(STORIMG(1))
IF (I1.EQ.0) I1 = 1
I2 = LENSTR(STORIMG(2))
IF (I2.EQ.0) I2 = 1
WRITE(IOUT,FMT=6010) IDTMP,NREC,ISTART,IYLEN,IADD,NBYTE,
+ ODFILE(1:LENSTR(ODFILE)),
+ STORIMG(1)(1:I1),STORIMG(2)(1:I2)
IF (ONLINE) WRITE(ITOUT,FMT=6010) IDTMP,NREC,ISTART,IYLEN,
+ IADD,NBYTE,ODFILE(1:LENSTR(ODFILE)),
+ STORIMG(1)(1:I1),STORIMG(2)(1:I2)
END IF
C
C---- See if image already in memory
C
IF (((IADD.EQ.0).AND.((ODFILE.EQ.STORIMG(1)).AND.
+ (.NOT.FORCEREAD))) .OR.
+ ((IADD.NE.0).AND.((ODFILE.EQ.STORIMG(2)).AND.
+ (.NOT.FORCEREAD))))
+ THEN
if(machine.eq.'MAR '.or.machine.eq.'CBF ')then
C print*,'First call to CBF_INFO'
call cbf_info(odfile,modeop)
endif
IF(MACHINE.NE.'CBF ')THEN
CALL QOPEN(INOD,ODFILE,'READONLY')
GOTO 17
END IF
ENDIF
IF (WINOPEN) CALL MXDBSY(0,'Reading image')
CALL TIFF(ODFILE,IMAGE(1+IADD*IYLEN),NREC,IYLEN,IERR)
IF (WINOPEN) CALL MXDBSY(-1, ' ')
C
C---- Set "strip read" flag true for all strips
C
17 DO 15 IBLK = 1,NREC
RDSTRIP(IBLK) = .TRUE.
15 CONTINUE
GOTO 40
END IF
C
IF (IMGP) THEN
IF (VAXVMS()) THEN
C
C---- Use a large blocksize to speed up data transfer.
C
OPEN(UNIT=INOD,FILE=ODFILE,STATUS='OLD',FORM='UNFORMATTED')
ELSE
if(machine.eq.'MAR '.or.machine.eq.'CBF ')then
C print*,'Second call to CBF_INFO'
call cbf_info(odfile,modeop)
endif
IF(MACHINE.NE.'CBF ')THEN
CALL QOPEN(INOD,ODFILE,'READONLY')
CALL QMODE (INOD,0,NCMITM)
call qqinq(INOD,ODFILE,ODFILE,ifilesize)
ENDIF
END IF
ELSE
IF (VAXVMS()) THEN
C
C---- Long words for Vax
C
IREC = NWORD/2
C
C---- Use a large blocksize to speed up data transfer.
C
OPEN (UNIT=INOD,FILE=ODFILE,
+ ACCESS='DIRECT',RECL=IREC,FORM='UNFORMATTED',STATUS='OLD')
ELSE
C
if(machine.eq.'MAR '.or.machine.eq.'CBF ')then
C print*,'Third call to CBF_INFO'
call cbf_info(odfile,modeop)
endif
IF(MACHINE.NE.'CBF ')THEN
CALL QOPEN(INOD,ODFILE,'READONLY')
CALL QMODE (INOD,0,NCMITM)
endif
END IF
END IF
C
C---- Work out record number in file of the first strip of
C ods for the first film to be processed in this pack
C this information is passed to rdblk via common /scn/
C NREC, NBYTE are set up in site-specific code in CONTROL, or
C via keyword SIZE
C
16 ICURR = 0
C
IF (.NOT.ONEFILE) THEN
ICURR=(NFIRSTI-1)*NREC*NBYTE
FORCEREAD = .FALSE.
RETURN
END IF
C
C
C---- if INCORE = .TRUE. then read all image into memory NOW!
C
IF (.NOT.INCORE) RETURN
C
C---- If summing partials, two images are held in memory at any
C one time and we must set a pointer to read the next image
C into the appropriate part of image.
C
C---- Read image into memory
C
IF (SUMPART.AND.(.NOT.FIRST_TIME)) THEN
IF (MODEOP.NE.3) THEN
IF (ISTART.EQ.0) IADD = NREC
IF (ISTART.EQ.NREC) IADD = 0
ELSE
IADD = ISTART
END IF
END IF
C
IF (DEBUG(45)) THEN
I1 = LENSTR(STORIMG(1))
IF (I1.EQ.0) I1 = 1
I2 = LENSTR(STORIMG(2))
IF (I2.EQ.0) I2 = 1
WRITE(IOUT,FMT=6010) IDTMP,NREC,ISTART,IYLEN,IADD,NBYTE,
+ ODFILE(1:LENSTR(ODFILE)),
+ STORIMG(1)(1:I1),STORIMG(2)(1:I2)
IF (ONLINE) WRITE(ITOUT,FMT=6010) IDTMP,NREC,ISTART,IYLEN,
+ IADD,NBYTE,ODFILE(1:LENSTR(ODFILE)),
+ STORIMG(1)(1:I1),STORIMG(2)(1:I2)
6010 FORMAT(1X,'About to store image, idtmp=',I4,/,1X,
+ 'NREC=',I5,' ISTART=',I5,' IYLEN=',I5,' IADD=',I5,
+ ' NBYTE=',I6/,1X,'IMAGE filename: ',A,/,1X,
+ 'File stored in first slot : ',A,/,1X,
+ 'File stored in second slot: ',A)
END IF
C
C---- Read for a packed image file
C
IF (PACK) THEN
IF (MODEOP.EQ.2) THEN
CALL IMSIZ(ODFILE,NREC,IYLEN)
RETURN
END IF
C
C---- See if image already in memory
C
IF (((IADD.EQ.0).AND.((ODFILE.EQ.STORIMG(1)).AND.
+ (.NOT.FORCEREAD))) .OR.
+ ((IADD.NE.0).AND.((ODFILE.EQ.STORIMG(2)).AND.
+ (.NOT.FORCEREAD))))
+ GOTO 19
C
IF (WINOPEN) CALL MXDBSY(0,'Reading image')
CALL READPACK_WORD(IMAGE(1+IADD*IYLEN),ODFILE)
C
C
IF (INVERTX)
+ CALL IMGINV(IMAGE(1+IADD*IYLEN),NREC,IYLEN,ICONST)
C
IF (DEBUG(45)) THEN
DO 18 I = 1,NREC
IF ((I.GE.NREC/2).AND.(I.LE.NREC/2+5)) THEN
IBEG = (I-1)*IYLEN + IADD*IYLEN
IEND = IBEG + NDEBUG(45) - 1
IND1 = 1
IND2 = NDEBUG(45)
WRITE(IOUT,FMT=6012) IND1,IND2,I,
+ (IMAGE(K),K=IBEG,IEND)
IF (ONLINE) WRITE(ITOUT,FMT=6012) IND1,IND2,
+ I,(IMAGE(K),K=IBEG,IEND)
6012 FORMAT(1X,'Pixel values for pixels',I5,' to',I5,
+ ' in stripe',I5,' in the ',
+ 'inverted image'/,(1X,20I6))
END IF
18 CONTINUE
END IF
19 DO 20 IBLK = 1,NREC
RDSTRIP(IBLK) = .TRUE.
20 CONTINUE
IF (WINOPEN) CALL MXDBSY(-1, ' ')
GOTO 40
END IF
IF(MACHINE.NE.'CBF ')THEN
C
C---- Read in header records (if any). The need for byte swapping is
C determined by looking at the image size in the header record.
C If it is not 1200,1600,2000 or 2300 for Mar images or 950/1900 for R-axis
C then the byte order is swapped, if still not 1200,1600,2000,2300 for Mar
C or 950/1900 for R-axis an error is given. This is done in GETHDR
C
IF (NHEAD.NE.0) THEN
C
C---- Set a default BYTSWAP in case header records are just going to be
C skipped.
C
BYTSWAP = (.NOT.LITEND())
C
CALL GETHDR(NOVFL,NRECOVFL,ISTAT)
C
C---- Check for error in read
C
IF (ISTAT.LT.0) THEN
IF (ONLINE.AND.WINOPEN) THEN
IF (ISTAT.EQ.-1) ID = -1001
IF (ISTAT.EQ.-2) ID = -1002
RETURN
ELSE
CALL SHUTDOWN
END IF
END IF
C
C---- If phi START angle not specified in keyword input, get them from header
C
IF ((ISTRT.EQ.0).AND.(IPACK.NE.0)) THEN
PHIBEGA(IPACK+(IDTMP-ID)) = HPHIS
PHIENDA(IPACK+(IDTMP-ID)) = HPHIE
END IF
ELSE
C
C---- Prototype Mar (no header) always written on Vaxes so just need to
C determine byte order on this machine to know if byte swapping
C is needed.
C
C Corrected MD images are supposed to be written as little endian
C so the same holds true
C
BYTSWAP = (.NOT.LITEND())
C
C---- For Fuji images from CHESS they are written by Suns so opposite is true.
C
IF (MACHINE.EQ.'FUJI') BYTSWAP = (LITEND())
C
C---- For DIP2000 images are also written by Suns
C
IF (MACHINE.EQ.'DIP2') BYTSWAP = (LITEND())
END IF
C
C---- Allow possibility of reversing choice with keyword BSWAP (sets FIXSWAP)
C
IF (FIXSWAP.AND.FIRSTSWAP) THEN
BYTSWAP = (.NOT.BYTSWAP)
FIRSTSWAP = .FALSE.
END IF
C
C---- If this call is only to get image size, close OD file and return unless
C this is a Mac Science scanner, in which case need to read whole image
C in order to get the tail record information
C
IF ((MODEOP.EQ.2).AND.(MACHINE.NE.'DIP2')) THEN
IF (VAXVMS()) THEN
C *************
CLOSE (UNIT=INOD)
C *************
ELSE
C *************
CALL QCLOSE(INOD)
C *************
END IF
RETURN
END IF
C
C
C---- Special subroutine to read packed Mar345 images. The MODEL has
C been assigned to "345" in GETHDR on basis of the first word in the
C image header
C
IF (MODEL.EQ.'M345') THEN
C
C---- See if image already in memory
C
IF (((IADD.EQ.0).AND.((ODFILE.EQ.STORIMG(1)).AND.
+ (.NOT.FORCEREAD))) .OR.
+ ((IADD.NE.0).AND.((ODFILE.EQ.STORIMG(2)).AND.
+ (.NOT.FORCEREAD))))
+ GOTO 40
C
IF (WINOPEN) CALL MXDBSY(0,'Reading image')
C
INFO(3) = IADD
NCHAR = LENSTR(ODFILE)
DO 22 I = 1,NCHAR
IFILENAM(I) = ICHAR(ODFILE(I:I))
22 CONTINUE
IFILENAM(NCHAR+1) = 0
C
CALL OPENFILE(IFILENAM,IMAGE(1+IADD*IYLEN))
IF (INVERTX)
+ CALL IMGINV(IMAGE(1+IADD*IYLEN),NREC,IYLEN,ICONST)
DO 24 IBLK = 1,NREC
RDSTRIP(IBLK) = .TRUE.
24 CONTINUE
IF (WINOPEN) CALL MXDBSY(-1, ' ')
GOTO 40
END IF
C
C---- See if image already in memory
C
IF (((IADD.EQ.0).AND.((ODFILE.EQ.STORIMG(1)).AND.
+ (.NOT.FORCEREAD))) .OR.
+ ((IADD.NE.0).AND.((ODFILE.EQ.STORIMG(2)).AND.
+ (.NOT.FORCEREAD))))
+ GOTO 40
C
IF (WINOPEN) CALL MXDBSY(0,'Reading image')
C
DO 30 IBLK = 1,NREC
C
C---- Some scanners put out the image inverted left to right compared with
C what MOSFLM expects, so correct for that by reading the image
C inverted here (Mar and Fuji at Chess)
C
IF (IMGP.AND.(INVERTX)) THEN
IPOINT = (NREC-IBLK)*IYLEN + 1 + IADD*IYLEN
ELSE
IPOINT = (IBLK-1)*IYLEN + 1 + IADD*IYLEN
END IF
RDSTRIP(IBLK) = .TRUE.
C
IERR = 0
C **********************************************
CALL GETBLK(IMAGE(IPOINT),NBYTE,IBLK+NHEAD,ISWAP,IERR)
C **********************************************
C
C---- Trap error in read
C
IF (IERR.NE.0) THEN
WRITE(IOUT,FMT=6014) IBLK
IF (ONLINE) WRITE(ITOUT,FMT=6014) IBLK
6014 FORMAT(/,1X,'Error trying to read record number',I6,
+ ' in image file.',/,1X,'Check that the file is',
+ ' the correct length')
IF (ONLINE.AND.WINOPEN) THEN
ID = -1001
RETURN
ELSE
CALL SHUTDOWN
END IF
END IF
C
C---- Now deal with pixel values gt 32767 for Mar scanner and convert from
C log to linear scale for Fuji scanner.
C For MAR,CCD,FUJI and UNKNOWN scanners values greater than 32767
C are stored as -(true value)/8
C
IF ((MACHINE.EQ.'MAR ').OR.(MACHINE.EQ.'FUJI').OR.
+ (MACHINE.EQ.'DIP2').OR.(MACHINE.EQ.'CCD1').OR.
+ (MACHINE.EQ.'CCD2').OR.(MACHINE.EQ.'UNK').OR.
+ (MACHINE.EQ.'ADSC').OR.(MACHINE.EQ.'MARC').OR.
+ (MACHINE.EQ.'LIPS').OR.(MACHINE.EQ.'SBC1').OR.
$ (MACHINE.EQ.'JUPI').OR.(MACHINE.EQ.'BRUK')) THEN
DO 32 I = 1,IYLEN
IOD = IMAGE(IPOINT+I-1)
IF ((MACHINE.EQ.'MAR ').OR.(MACHINE.EQ.'CCD1').OR.
+ (MACHINE.EQ.'CCD2').OR.(MACHINE.EQ.'UNK').OR.
+ (MACHINE.EQ.'ADSC').OR.(MACHINE.EQ.'MARC').OR.
+ (MACHINE.EQ.'LIPS').OR.(MACHINE.EQ.'SBC1').OR.
$ (MACHINE.EQ.'JUPI').OR.(MACHINE.EQ.'BRUK')) THEN
IF (IOD.LT.0) IMAGE(IPOINT+I-1) = -(IOD+65536+4)/8
ELSE IF (MACHINE.EQ.'FUJI') THEN
IOD = NINT(10.0**(FLOAT(IOD)*LOGA/LOGB))
IF (IOD.GT.32767) IOD = -(IOD+4)/8
IMAGE(IPOINT+I-1) = IOD
ELSE IF (MACHINE.EQ.'DIP2') THEN
CONTINUE
END IF
C
C---- If requested, add ICONST to all pixel values.For DIP2 it will only
C be added to pixels with values less than 32767, since values above
C this are multiples of 128, so assuming ICONST is small it will have
C no real effect.
C
IF (ADDALL) THEN
IF (MACHINE.EQ.'DIP2') THEN
IF (IOD.GE.0) IOD = IOD + ICONST
IF (IOD.GT.32767) IOD = 32767
ELSE
IF ((IOD.LT.(32766-ICONST)).AND.(IOD.GE.0)) THEN
IOD = IOD + ICONST
ELSE IF (IOD.LT.0) THEN
IOD = -(IOD+65536+4+ICONST)/8
END IF
END IF
IMAGE(IPOINT+I-1) = IOD
END IF
32 CONTINUE
END IF
C
IF (DEBUG(45).AND.((IBLK.GE.NREC/2).AND.
+ (IBLK.LE.NREC/2+5))) THEN
IBEG = IPOINT
IEND = IBEG + NDEBUG(45) - 1
IF (IMGP.AND.(INVERTX)) THEN
NSTRIPE = NREC-IBLK+1
ELSE
NSTRIPE = IBLK
END IF
IND1 = 1
IND2 = NDEBUG(45)
WRITE(IOUT,FMT=6012) IND1,IND2,
+ NSTRIPE,(IMAGE(K),K=IBEG,IEND)
IF (ONLINE) WRITE(ITOUT,FMT=6012) IND1,IND2,
+ NSTRIPE,(IMAGE(K),K=IBEG,IEND)
END IF
C
30 CONTINUE
C
C---- Read tail record for DIP2000 images
C
IF (MACHINE.EQ.'DIP2') CALL GETTAIL(NREC,IYLEN,IWAVE,IDIST)
C
C---- Now deal with overload records from end of scan
C
IF ((MACHINE.EQ.'MAR ').AND.(NHEAD.NE.0))
+ CALL GETOVR(IMAGE(1+IADD*IYLEN),NREC,IYLEN,NOVFL,NRECOVFL)
C
IF (WINOPEN) CALL MXDBSY(-1, ' ')
C
C---- end of block for non-CBF type images
C
ENDIF
C
C---- If adding in partials from second image and this is the first
C image to be read, read the second one now.
C
C
C---- Save the complete filename of image
C
40 IF (IADD.EQ.0) THEN
STORIMG(1) = ODFILE
ELSE
STORIMG(2) = ODFILE
END IF
C
C---- Return if Mac Science scanner and MODEOP=2
C
CHRP (from Atsushi Nakagawa) IF ((MODEOP.EQ.2).AND.(MACHINE.EQ.'DIP2')) RETURN
C
IF (SUMPART) THEN
IF (.NOT.FIRST_TIME) THEN
FORCEREAD = .FALSE.
CAL RETURN
GOTO 50
END IF
FIRST_TIME = .FALSE.
MODEOP = 0
C
C---- Close the image file of first image. Note it is opened with DISKIO
C under Unix, Fortran under VMS.
C
IF (.NOT.PACK.and.machine.ne.'CBF ') THEN
IF (VAXVMS()) THEN
C *************
CLOSE (UNIT=INOD)
C *************
ELSE
C *************
CALL QCLOSE(INOD)
C *************
END IF
END IF
GOTO 10
END IF
50 IF (.NOT.PACK.and.machine.ne.'CBF ') THEN
IF (VAXVMS()) THEN
C *************
CLOSE (UNIT=INOD)
C *************
ELSE
C *************
CALL QCLOSE(INOD)
C *************
END IF
END IF
C
C add for jpeg output - this implementation does not allow for zooming here,
C although WRITE_JPEG has this ability
C
PIXMIN = 0
PIXMAX = 32767
XMIN = 0
XMAX = 0
YMIN = 0
YMAX = 0
ZOOM = 1
IF(JPGOUT)CALL WRITE_JPEG(SERVERFD,NREC,IYLEN,IMAGE,PIXMIN,
$ PIXMAX,ZOOM,XMIN,XMAX,YMIN,YMAX)
RETURN
C
C---- Format statements
C
1008 FORMAT(/' !!! OPENODS: Can''t find filename for pack ',A/)
1001 FORMAT(' image filenames: ',$)
1007 FORMAT(' No image filenames given')
1002 FORMAT(A)
6000 FORMAT (I3.3)
6002 FORMAT (1X,'image FILENAME: ',A)
6003 FORMAT (//1X,'**** WARNING ***',/1X,'Image FILE ',A,/,1X,
+ 'Required for adding partials does not exist, so',
+ ' partial summation has been turned off')
6004 FORMAT (//1X,'**** ERROR ****',/1X,'Image FILE ',A,
+ ' DOES NOT EXIST')
6005 FORMAT (//1X,'**** ERROR ****',/1X,'Trying to open image file to'
+ ,' get image size but image FILE ',/,1X,A,
+ ' DOES NOT EXIST')
6006 FORMAT(1X,'This is a packed image file')
C
END
C== OVERLAP ==
C
C
C
SUBROUTINE OVERLAP
C ==================
C
IMPLICIT NONE
C
C---- Tests for overlapping reflexions.
C This routine first sorts on X to speed up the calculation.
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,J,NSPB,NSPE,IRECG,IHKLG,IR,IM,IIH,IIK,IIL,IR2
REAL DELX,DELY,THETA,CTHSQ,STHSQ,RSQ,RADSQ,MDTXSQ,MDTYSQ,XR,YR,
+ XMINDTX,XMINDTY
C ..
C .. Local Arrays ..
C
C
INTEGER IH(7),IN(NREFLS)
C ..
C .. External Subroutines ..
EXTERNAL GETHKL,SORTUP5,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
C ..
C .. Equivalences ..
SAVE
C ..
C
XMINDTX = REAL(MINDTX)
XMINDTY = REAL(MINDTY)
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6000) NSPOT,MINDTX,MINDTY
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSPOT,MINDTX,MINDTY
END IF
6000 FORMAT(1X,'*** SUBROUTINE OVERLAP ***',/,1X,
+ 'NSPOT',I6,' MINDTX,MINDTY',2I8)
C
MDTXSQ = 0.25*MINDTX**2
MDTYSQ = 0.25*MINDTY**2
C
C---- Initialise number of spatially overlapped partials at start of
C oscillation range. If using ADDPART thes must be flagged as spatially
C overlaps on the PRECEEDING image.
C
NPOVL = 0
IF (NSPOT.GT.1) THEN
C
C---- Sort reflections on X coord storing order in IN
C
C *******************
CALL SORTUP5(NSPOT,XG,IN)
C *******************
C
C---- Now test for overlaps
C NSPB and NSPE are pointers to spots within the sorted list
C
NSPB = 1
NSPE = NSPB
10 CONTINUE
NSPE = NSPE + 1
C
C
IF (NSPE.LE.NSPOT) THEN
20 CONTINUE
C
IF (XG(IN(NSPE)).GE.XG(IN(NSPB))+XMINDTX) THEN
NSPB = NSPB + 1
C
C
IF (NSPB.EQ.NSPE) THEN
GO TO 10
ELSE
GO TO 20
END IF
C
C
END IF
C
C
YR = YG(IN(NSPE))
XR = XG(IN(NSPE))
C
C
DO 30 I = NSPB,NSPE - 1
C
C
IF (ABS(YG(IN(I))-YR).LT.XMINDTY) THEN
C
C---- We might have an overlap, but now need to calculate actual
C spot centre separation and compare this with spot size in the
C direction of the contact, assuming spot is elliptical with
C dimensions MINDTX in X direction and MINDTY in Y direction.
C
DELX = XG(IN(I))-XR
DELY = YG(IN(I))-YR
RSQ = DELX*DELX + DELY*DELY
IF (RSQ.EQ.0.0) THEN
THETA = 0.0
ELSE
THETA = ATAN2(DELY,DELX)
END IF
CTHSQ = COS(THETA)**2
STHSQ = SIN(THETA)**2
RADSQ = 4.0*(MDTXSQ*MDTYSQ)/(MDTYSQ*CTHSQ + MDTXSQ*STHSQ)
IF (RSQ.LT.RADSQ) THEN
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6008) IN(I),IN(NSPE)
IF (ONLINE) WRITE(ITOUT,FMT=6008) IN(I),IN(NSPE)
END IF
6008 FORMAT(1X,'Overlap of records',I6,' and ',I6)
C
C---- We have an overlap. Reset flag JR unless spot is
C outside DSTAR limit or detector limits
C
C---- Note that spots will be flagged as overlaps that have
C already failed both ends tests in SPTEST, but those
C failing limits tests will not be flagged (28/1/97)
C
IRECG = IN(I)
IR = IRG(IRECG)
IM = IMG(IRECG)
C
C---- If using ADDPART, test for spatial overlap for partial at start
C of oscillation range, because this will already have been added
C to partial on previous image
C
IF (IM.LT.0) THEN
NPOVL = NPOVL + 1
IF (NPOVL.GT.NREFLS/2) THEN
WRITE(IOUT,FMT=6010) NREFLS/2
IF (ONLINE) WRITE(ITOUT,FMT=6010) NREFLS/2
6010 FORMAT(1X,'**** FATAL ERROR ****',/,1X,
+ 'More than',I6,' spatial overlaps which are partial',
+ ' at start of oscillation',/,1X,'This is extremely ',
+ 'unlikely and suggests an error in input.',/,1X,
+ 'If this is not the case,Change size of array',
+ ' HKLPOVL in common block /over/ and recompile')
CALL SHUTDOWN
END IF
C
C---- Need to watch for integer*2 overflow, hence conversion
C to I*4 variable
C
C---- Note that this does not restrict indices to be less than 255, as we only
C test for equality of the packed indices. However, the unpacking of
C the h,k,l will not work if indices are greater than 255, but this is
C only used for debug output and the algorithm does not depend on it.
C
C
IIH = IHG(IRECG)
IIK = IKG(IRECG)
IIL = ILG(IRECG)
IHKLG = ((IIH+256)*512+(IIK+256))*512 +
+ IIL + 256
HKLPOVL(NPOVL) = IHKLG
IF (DEBUG(32)) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6012) IRECG,(IH(J),J=1,5)
IF (ONLINE) WRITE(ITOUT,FMT=6012) IRECG,(IH(J),J=1,5)
6012 FORMAT(1X,'Overlapped partial, record number',I6,
+ ' indices',3I5,' IM',I5,' IR',I5)
END IF
END IF
C
C For TESTGEN options,
C---- Do NOT include as overlaps reflections that are too wide in phi
C (IR=3) or outside resolution range (IR=4) or within cusp (IR=10)
C
IRECG = IN(NSPE)
IR2 = IRG(IRECG)
IF (TESTGEN) THEN
IF ((IR.NE.4).AND.(IR.NE.3).AND.(IR.NE.10).AND.
+ (IR2.NE.4).AND.(IR2.NE.3).AND.(IR2.NE.10)) THEN
IRG(IN(I)) = 2
IRG(IN(NSPE)) = 2
END IF
ELSE
C
C---- Do not flag as spatial overlaps reflections that are in fact
C outside defined limits of detector (flagged with IR=1 in sptest)
C 28/1/97
C
IF ((IR.NE.4).AND.(IR.NE.1)) THEN
IRG(IN(I)) = 2
IRG(IN(NSPE)) = 2
END IF
END IF
C
C
IM = IMG(IRECG)
C
IF (IM.LT.0) THEN
NPOVL = NPOVL + 1
IF (NPOVL.GT.NREFLS/2) THEN
WRITE(IOUT,FMT=6010) NREFLS/2
IF (ONLINE) WRITE(ITOUT,FMT=6010) NREFLS/2
CALL SHUTDOWN
END IF
C
C---- Need to watch for integer*2 overflow, hence conversion
C to I*4 variable
C
C---- Note that this does not restrict indices to be less than 255, as we only
C test for equality of the packed indices. However, the unpacking of
C the h,k,l will not work if indices are greater than 255, but this is
C only used for debug output and the algorithm does not depend on it.
C
C
IIH = IHG(IRECG)
IIK = IKG(IRECG)
IIL = ILG(IRECG)
IHKLG = ((IIH+256)*512+(IIK+256))*512 +
+ IIL + 256
HKLPOVL(NPOVL) = IHKLG
IF (DEBUG(32)) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6012) IRECG,(IH(J),J=1,5)
IF (ONLINE) WRITE(ITOUT,FMT=6012) IRECG,(IH(J),J=1,5)
END IF
END IF
C
END IF
END IF
30 CONTINUE
C
C
GO TO 10
END IF
C
C
END IF
C
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6020) NPOVL
IF (ONLINE) WRITE(ITOUT,FMT=6020) NPOVL
6020 FORMAT(1X,'From OVERLAP, number of spatially overlapped ',
+ 'partials at start of oscillation',I4)
END IF
C
END
C== OVERLAP2 ==
C
C
C
SUBROUTINE OVERLAP2(IPACKPREV)
C ==========================
C
IMPLICIT NONE
C
C---- This deals with spatial overlaps that have been picked up on
C partials at the start of the current image, and which, when
C using the ADDPART option, need to be flagged as spatial overlaps
C on the PREVIOUS image.
C OVERLAP has stored the indices of overlapped partials in HKLPOVL
C and now need to find these reflections in previous image. Sort
C on packed indices (h,k,l) to expidite this.
C
C IPACKPREV is the record number of pack header of the previous image
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER IPACKPREV
C ..
C .. Local Scalars ..
INTEGER I,J,NNSPT,IHKLP1,IHKLP2,IERR,NP,NFOUND,IRECG,IHK,IH1,
+ IRMG,IR,IM
C ..
C .. Local Arrays ..
C
C
INTEGER IBUFFP(45),IHKL(NREFLS),IH(3),IORD1(NREFLS),
+ IORD2(NREFLS/2),IRECOVL(NREFLS/2)
INTEGER*2 IBUF(18)
C ..
C .. External Subroutines ..
EXTERNAL SORTUP4,SORTUP,QSEEK,QREAD,QWRITE,QBACK,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C ..
C .. Equivalences ..
SAVE
C ..
C
C---- Position generate file ready for reading reflection list of
C previous image
C
C ************************
CALL QSEEK(IUNIT,IPACKPREV,1,36)
C ************************
IPACKREC = IPACKPREV
C ************************
CALL QREAD(IUNIT,IBUFFP,180,IERR)
C ************************
IPACKREC = IPACKREC + 5
IF (IERR.NE.0) GOTO 200
NNSPT = IBUFFP(2)
C
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6000) NPOVL,IPACKPREV,NNSPT
IF (ONLINE) WRITE(ITOUT,FMT=6000) NPOVL,IPACKPREV,NNSPT
END IF
6000 FORMAT(1X,'*** SUBROUTINE OVERLAP2 ***',/,1X,
+ 'NPOVL',I6,' IPACKPREV',I6,' Nspots',I6)
C
IF (NNSPT.EQ.0) THEN
WRITE(IOUT,FMT=6002) IPACKPREV
IF (ONLINE) WRITE(ITOUT,FMT=6002) IPACKPREV
6002 FORMAT(1X,'*** FATAL ERROR ***',/,1X,'No spots ',
+ 'in generate file for pack starting at record',I6)
CALL SHUTDOWN
END IF
C
C---- Read and store all indices
C
DO 30 I = 1,NNSPT
C
C *************************
CALL QREAD(IUNIT,IBUF,36,IERR)
C *************************
C
IF (IERR.NE.0) GOTO 200
DO 20 J = 1,3
IH(J) = IBUF(J)
20 CONTINUE
C
C---- Note that this does not restrict indices to be less than 255, as we only
C test for equality of the packed indices. However, the unpacking of
C the h,k,l will not work if indices are greater than 255, but this is
C only used for debug output and the algorithm does not depend on it.
C
IHKL(I) = ((IH(1)+256)*512+(IH(2)+256))*512 + IH(3)
+ + 256
30 CONTINUE
C
IPACKREC = IPACKREC + NNSPT
C
C---- Sort reflections on packed hkl indices storing order in IN
C
C **********************
CALL SORTUP4(NNSPT,IHKL,IORD1)
C **********************
C---- Now sort the spatial overlaps
C
C **************************
CALL SORTUP4(NPOVL,HKLPOVL,IORD2)
C **************************
C---- Now find the overlapped reflections
C
NFOUND = 0
NP = 1
IHKLP2 = HKLPOVL(IORD2(NP))
DO 50 I = 1,NNSPT
IHKLP1 = IHKL(IORD1(I))
C
C---- Must allow for possibility that one of the overlaps (on current image)
C is not present in previous image reflection list
C
40 IF (IHKLP1.LE.IHKLP2) GOTO 42
IF (DEBUG(32)) THEN
IHK = IHKLP2/512
IH(1) = IHK/512
IH1 = IH(1)*512
IH(2) = IHK - IH1
IH(3) = IHKLP2 - (IH1+IH(2))*512
DO 44 J = 1,3
IH(J) = IH(J) - 256
44 CONTINUE
WRITE(IOUT,FMT=6010) NP,IH
IF (ONLINE) WRITE(ITOUT,FMT=6010) NP,IH
6010 FORMAT(1X,'No match for overlapped reflection number',I5,
+ ' indices',3I5)
END IF
NP = NP + 1
IF (NP.GT.NPOVL) GOTO 60
IHKLP2 = HKLPOVL(IORD2(NP))
GOTO 40
42 IF (IHKLP1.EQ.IHKLP2) THEN
NFOUND = NFOUND + 1
IRECOVL(NFOUND) = IORD1(I)
NP = NP + 1
IF (NP.GT.NPOVL) GOTO 60
IHKLP2 = HKLPOVL(IORD2(NP))
END IF
50 CONTINUE
60 IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6004) NPOVL,NFOUND
IF (ONLINE) WRITE(ITOUT,FMT=6004) NPOVL,NFOUND
6004 FORMAT(1X,'Of the',I4,' overlaps,',I4,' have been found')
END IF
C
C---- Now sort the record numbers
C
IF (NFOUND.EQ.0) RETURN
CALL SORTUP4(NFOUND,IRECOVL,IORD1)
C
C---- Now go through generate file updating IR flag
C
C *****************************
CALL QSEEK(IUNIT,IPACKPREV+5,1,36)
C *****************************
C
IPACKREC = IPACKPREV + 5
NP = 1
IRECG = IRECOVL(IORD1(NP))
DO 70 I = 1,NNSPT
C *************************
CALL QREAD(IUNIT,IBUF,36,IERR)
C *************************
IF (IERR.NE.0) GOTO 200
C
IF (I.EQ.IRECG) THEN
IRMG = IBUF(4)
IR = IRMG/256
IM = IRMG - IR*256 -128
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6008) IRECG,(IBUF(J),J=1,3),IR,IM
IF (ONLINE) WRITE(ITOUT,FMT=6008) IRECG,(IBUF(J),J=1,3),
+ IR,IM
6008 FORMAT(1X,'Found reflection at record number',I6,' indices',
+ 3I5,' IR',I3,' IM',I3)
END IF
IR = 2
IRMG = IR*256 + IM +128
IBUF(4) = IRMG
C ***********************
CALL QBACK(IUNIT,36)
CALL QWRITE(IUNIT,IBUF,36)
C ***********************
NP = NP + 1
IF (NP.GT.NFOUND) GOTO 80
IRECG = IRECOVL(IORD1(NP))
END IF
70 CONTINUE
IPACKREC = IPACKREC + NNSPT
WRITE(IOUT,FMT=6006)
IF (ONLINE) WRITE(ITOUT,FMT=6006)
6006 FORMAT(1X,'*** FATAL ERROR ***',/,1X,'In subroutine OVERLAP2',
+ ' cannot find all required records')
CALL SHUTDOWN
C
C---- Now reposition to end of current image (ie at same place that
C subroutine generate leaves it)
C
80 IPACKREC = IRECLAST
C
C ************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C ************************
RETURN
200 WRITE (IOUT,FMT=6050)
IF (ONLINE) WRITE (ITOUT,FMT=6050)
IF (BRIEF) WRITE (IBRIEF,FMT=6050)
6050 FORMAT (//1X,'*** ERROR Reading Generate file ***')
CALL SHUTDOWN
C
END
C== OVERLAPSP ==
C
C
C
SUBROUTINE OVERLAPSP(NSPOT,NREJOV)
C ==================================
C
IMPLICIT NONE
C
C---- Tests for overlapping spots from spotfinder
C This routine first sorts on X to speed up the calculation.
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER NSPOT,NREJOV
C ..
C .. Local Scalars ..
INTEGER I,J,NSPB,NSPE,IRECG,IHKLG,IR,IM,IIH,IIK,IIL,IR2,
+ in1,in2
REAL DELX,DELY,THETA,CTHSQ,STHSQ,RSQ,RADSQ,MDTXSQ,MDTYSQ,
+ XMINDTX,XMINDTY,XR,YR
C ..
C .. Local Arrays ..
C
C
INTEGER IH(7),IN(NREFLS)
C ..
C .. External Subroutines ..
EXTERNAL GETHKL,SORTUP5,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C include '../inc/tgen.f'
C ..
C .. Equivalences ..
SAVE
C ..
C
NREJOV = 0
XMINDTX = MINDTX
XMINDTY = MINDTY
C
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6000) NSPOT,MINDTX,MINDTY
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSPOT,MINDTX,MINDTY
END IF
6000 FORMAT(1X,'*** SUBROUTINE OVERLAPSP ***',/,1X,
+ 'NSPOT',I6,' MINDTX,MINDTY',2I8)
C
MDTXSQ = 0.25*MINDTX**2
MDTYSQ = 0.25*MINDTY**2
C
C
IF ((MINDTX.EQ.0).AND.(MINDTY.EQ.0)) RETURN
IF (NSPOT.GT.1) THEN
C
C---- Convert into 10 micron units (same as MINDTX, MINDTY)
C
DO 2 I = 1,NSPOT
XG(I) = 100.0*XSPOT(I)
YG(I) = 100.0*YSPOT(I)
2 CONTINUE
C
C---- Sort reflections on X coord storing order in IN
C
C *******************
CALL SORTUP5(NSPOT,XG,IN)
C *******************
C
C---- Now test for overlaps
C NSPB and NSPE are pointers to spots within the sorted list
C
NSPB = 1
NSPE = NSPB
10 CONTINUE
NSPE = NSPE + 1
C
C
IF (NSPE.LE.NSPOT) THEN
20 CONTINUE
C
C
IF (XG(IN(NSPE)).GE.XG(IN(NSPB))+XMINDTX) THEN
NSPB = NSPB + 1
C
C
IF (NSPB.EQ.NSPE) THEN
GO TO 10
ELSE
GO TO 20
END IF
C
C
END IF
C
C
YR = YG(IN(NSPE))
XR = XG(IN(NSPE))
C
C
DO 30 I = NSPB,NSPE - 1
C
C
IF (ABS(YG(IN(I))-YR).LT.XMINDTY) THEN
C
C---- We might have an overlap, but now need to calculate actual
C spot centre separation and compare this with spot size in the
C direction of the contact, assuming spot is elliptical with
C dimensions MINDTX in X direction and MINDTY in Y direction.
C
DELX = XG(IN(I))-XR
DELY = YG(IN(I))-YR
RSQ = DELX*DELX + DELY*DELY
IF (RSQ.EQ.0.0) THEN
THETA = 0.0
ELSE
THETA = ATAN2(DELY,DELX)
END IF
CTHSQ = COS(THETA)**2
STHSQ = SIN(THETA)**2
RADSQ = 4.0*(MDTXSQ*MDTYSQ)/(MDTYSQ*CTHSQ + MDTXSQ*STHSQ)
IF (RSQ.LT.RADSQ) THEN
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6008) IN(I),IN(NSPE)
IF (ONLINE) WRITE(ITOUT,FMT=6008) IN(I),IN(NSPE)
END IF
6008 FORMAT(1X,'Overlap of records',I6,' and ',I6)
C
C---- We have an overlap. Set intensities negative
C
IN1 = INSPOT(IN(I))
IN2 = INSPOT(IN(NSPE))
IF (IN1.GT.(5*IN2)) THEN
INSPOT(IN(NSPE)) = - ABS(IN2)
ELSE IF (IN2.GT.(5*IN1)) THEN
INSPOT(IN(I)) = - ABS(IN1)
ELSE
INSPOT(IN(I)) = - ABS(IN1)
INSPOT(IN(NSPE)) = - ABS(IN2)
END IF
END IF
C
C
END IF
30 CONTINUE
C
C
GO TO 10
END IF
C
DO 50 I = 1,NSPOT
IF (INSPOT(I).LT.0) NREJOV = NREJOV + 1
50 CONTINUE
C
END IF
C
IF (DEBUG(32)) THEN
WRITE(IOUT,FMT=6020) NREJOV
IF (ONLINE) WRITE(ITOUT,FMT=6020) NREJOV
6020 FORMAT(1X,'From OVERLAP, number of spatially overlapped ',
+ 'partials at start of oscillation',I4)
END IF
C
END
c*******************************************************************************
C== PACKBYTE ==
SUBROUTINE PACKBYTE(N)
C =====================
C
C
C---- Packs iod into n'th byte of bbint
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Arrays in Common ..
BYTE BBINT,BBSAVE
BYTE IOD
C ..
C .. Common blocks ..
COMMON /BITS/IOD(4),BBSAVE(2*MAXBOX),BBINT(2*MAXBOX)
SAVE
C ..
C
C
c
c-EL for dec5400/vax8600 in subroutine PACKBYTE
BBINT(N) = IOD(1)
c-EB for iris220GTX in subroutine PACKBYTE .. start modification
c NODD = MOD(N,2)
c IF (NODD.EQ.0) THEN
c BBINT(N-1) = IOD(4)
c ELSE
c BBINT(N+1) = IOD(4)
c END IF
c-EB for iris220GTX in subroutine PACKBYTE end modification
C
C
END
C== PARAB ==
SUBROUTINE PARAB(IOD,X)
C ==============================
C IMPLICIT NONE
C---- Parabolic fit to 3 values in IOD, returns the position of the minimum
C of the parabola. The X-coordinates of the 3 points are -1,0,1.
C ..
C .. Scalar Arguments ..
REAL X
C ..
C .. Array Arguments ..
INTEGER IOD(3)
C ..
C .. Local Scalars ..
REAL D,D23,D21
INTEGER I,J
D23 = IOD(2) - IOD(3)
D21 = IOD(2) - IOD(1)
D = D23 + D21
X = 0.0
IF (D.NE.0.0) X = - 0.5*(D23-D21)/D
END
c
c
C
SUBROUTINE PCKLIS(MS, NXPIX, NYPIX, IWHERE,IXW,IYW)
C =============================================
C
C List part of the image array MS into an io window (with overloads
C correctly decoded
C
C Returns :
C none
C
C Arguments :
C ms - array to list variables from
C type : integer*2 (NYPIX,NXPIX)
C access : readonly
C
C iwhere - position in array to display
C type : integer (4)
C access : readonly
C iwhere(1) - central y position
C iwhere(2) - central X position
C iwhere(3) - y extent
C iwhere(4) - X extent
C
C ixw,iyw position for output window (display pixels)
C
IMPLICIT NONE
C
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
INTEGER QYCENT, QXCENT, QYEXT, QXEXT
PARAMETER (QYCENT = 1, QXCENT = 2, QYEXT = 3, QXEXT = 4)
INTEGER IWHERE(4), IYSTRT, IXSTRT, IYEND, IXEND
INTEGER I, IY, J, K
INTEGER NYPIX, NXPIX, IXW, IYW
CVAX
INTEGER*2 MS(NYPIX, NXPIX)
CVAX
CHARACTER*1 BKSLSH
C
CHARACTER*200 LINE
C
integer linbuf(100), linlen, numlin, nypt, nXpt, intpxl
external intpxl
C
BKSLSH = CHAR(92)
IYSTRT = IWHERE(QYCENT) - (IWHERE(QYEXT) / 2)
IXSTRT = IWHERE(QXCENT) - (IWHERE(QXEXT) / 2)
IYEND = IYSTRT + IWHERE(QYEXT) - 1
IXEND = IXSTRT + IWHERE(QXEXT) - 1
C
C Check boundaries:
C
IYSTRT = MAX(IYSTRT, 1)
IXSTRT = MAX(IXSTRT, 1)
IYEND = MIN(IYEND, NYPIX)
IXEND = MIN(IXEND, NXPIX)
NXPT = IXEND - IXSTRT + 1
NYPT = IYEND - IYSTRT + 1
LINLEN = 6*NXPT + 8
NUMLIN = NYPT + 5
C
C Create SECOND IO window
call mxdcio(10,linlen, numlin, ixw,iyw)
C
C List it on the terminal like it is in the displayed image
C
IF (INVERTX) THEN
WRITE (LINE, 6000) (I, I = NREC-IXSTRT+1, NREC-IXEND+1, -1)
ELSE
WRITE (LINE, 6000) (I, I = IXSTRT, IXEND)
END IF
6000 FORMAT (1X, 'X = ', 50I6)
call mxdwio(line, 12)
WRITE (LINE, 6100) BKSLSH, '/'
6100 FORMAT (1X, 2A1, ' Y ')
call mxdwio(line, 12)
DO 100 I = IWHERE(QYEXT), 1, -1
IY = IYSTRT - 1 + I
K = 0
DO 110 J = IXSTRT, IXEND
K = K+1
LINBUF(K) = INTPXL(MS(IY, J))
110 CONTINUE
WRITE (LINE, 6200) IY, (LINBUF(K), K = 1, NXPT)
6200 FORMAT (1X, I4, ': ', 50I6)
call mxdwio(line, 12)
100 CONTINUE
WRITE (LINE, 6100) '/', BKSLSH
call mxdwio(line, 12)
IF (INVERTX) THEN
WRITE (LINE, 6000) (I, I = NREC-IXSTRT+1, NREC-IXEND+1, -1)
ELSE
WRITE (LINE, 6000) (I, I = IXSTRT, IXEND)
END IF
call mxdwio(line, 12)
C
RETURN
END
SUBROUTINE PERMUTATE(CELL,AMAT,ICRYST,LATTYP)
C Subroutine to allow for the user's preference apropos the order in cell
C dimensions; DPS indexing forces a <= b <= c for triclinic and orthorhombic,
C a <= c for monoclinic. Sometimes there is a good reason for not doing this!
C
C This subroutine has DEBUG(73), cleed with 'DEBUG PERMUTE'
C
C COMMON BLOCK USED IN PERMUTING THE CELL
C
C&&*&& include ../inc/dpsindex.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file dpsindex.h
C
C
REAL DISTANCE,XTD,WAVELENGTH,XBEAM,YBEAM,PHIAV,DMAX,
$ ORGX,ORGY,XCOR,YCOR
INTEGER*4 IXD,IYD,IPHI,SOLN
INTEGER*2 IH,IK,IL
LOGICAL INDNOREF,DPSINDEX,PREREF,LSOL
COMMON /DPSINDEX/ DISTANCE,XTD,WAVELENGTH,XBEAM,YBEAM,
$ PHIAV,DMAX,ORGX,ORGY,XCOR,YCOR,IXD(5000),
$ IYD(5000),IPHI(5000),SOLN,IH(5000),IK(5000),
$ IL(5000),INDNOREF,DPSINDEX,PREREF,LSOL
C
C
C COMMON BLOCK USED IN PERMUTING THE CELL
C
REAL KCELL(6)
INTEGER KICRYST
COMMON /PERMUTE/ KCELL,KICRYST
C
C
C&&*&& end_include ../inc/dpsindex.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
REAL CELL(6),AMAT(3,3),AMATZ(3,3)
INTEGER I,J,LOCALERRFLG
INTEGER ICRYST
REAL ACB(3,3),BAC(3,3),BCA(3,3),CAB(3,3),CBA(3,3)
CHARACTER*1 LATTYP
EXTERNAL MATMUL3
DATA ACB /1,0,0, 0,0,1, 0,-1,0/
DATA BAC /0,-1,0, 1,0,0, 0,0,1/
DATA CBA /0,0,-1, 0,1,0, 1,0,0/
DATA CAB /0,1,0, 0,0,1, 1,0,0/
DATA BCA /0,0,1, 1,0,0, 0,1,0/
C
C We have the six possible permutations of the cell axes. Of course, we really
C shouldn't allow silly combinations, e.g. hexagonal with a* unique...
C
C First check for silly lattice/cell parameter combinations; only a problem
C with monoclinic, as some people still want alpha or gamma unique.
C
C We'll use the ICRYST numbers rather than lattice names; the translation is
C lattice ICRYST
C triclinic 1
C monoclinic 2
C orthorhombic 3
C tetragonal 4
C trigonal 5
C hexagonal 6
C cubic 7
C rhombohedral 8
C
C these have fixed relationships so cannot be permuted!
C
IF ((ICRYST .GE. 4) .AND. (ICRYST .LE. 8)) THEN
RETURN
ENDIF
C
C AMAT ---> dummy array AMATZ
C
CALL MATCOPF(AMATZ,AMAT,3,3)
c DO 20 I=1,3,1
c DO 10 J=1,3,1
c AMATZ(I,J)=AMAT(I,J)
c 10 CONTINUE
c 20 CONTINUE
IF (KICRYST .EQ. ICRYST) THEN
IERRFLG = 0
C
C
C check for monoclinic
C IF ((ICRYST .EQ. 2) .AND.
C $ ((kCELL(4) .NE. 90.0) .OR. (kCELL(6) .NE. 90.0))) THEN
C print*,'This is not a standard monoclinic cell with beta'
C print*,'unique and alpha and gamma both equal to 90.'
C print*,'You must give a valid cell!'
C IERRFLG = 1
C RETURN
C ENDIF
C
C check for orthorhombic
C IF ((ICRYST .EQ. 3) .AND.
C $ (KCELL(4) .NE. 90.0) .AND. (KCELL(4) .NE. KCELL(5)).AND.
C $ (KCELL(4) .NE. KCELL(6))) THEN
C print*,'This is not a standard orthorhombic cell'
C print*,'alpha = beta = gamma = 90'
C print*,'You must give a valid cell!'
C IERRFLG = 1
C RETURN
C ENDIF
C C
C that's the check for the daft user over. Now for the real stuff...
C
C
C now CHECK FOR lattice type; A, B, C can't be changed easily so we won't
C allow it!
C
IF ((LATTYP .EQ. 'A') .OR. (LATTYP .EQ. 'B') .OR.
$ (LATTYP .EQ. 'C')) THEN
C PRINT*,'This lattice type cannot be changed easily, so we'
C PRINT*,'use the standard setting'
LOCALERRFLG = 1
ENDIF
IF (((KCELL(1) .LT. KCELL(2)) .and. (KCELL(2) .LT. KCELL(3))
$ .AND. (KCELL(1) .LT. KCELL(3))) .OR. (LOCALERRFLG .EQ. 1))
$ then
LOCALERRFLG = 0
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=170)
IF(ONLINE)WRITE(ITOUT,FMT=170)
ENDIF
return
endif
C
C separate checks for (orthorhombic and triclinic) and monoclinic
C
IF ((ICRYST .EQ. 1) .OR. (ICRYST .EQ. 3)) THEN
C
C---- (1) ACB
C
IF ((KCELL(1) .LT. KCELL(2)) .and. (KCELL(3) .LT. KCELL(2))
$ .AND. (KCELL(1) .LT. KCELL(3))) then
CALL MATMUL3(AMAT,AMATZ,ACB)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=120)
IF(ONLINE)WRITE(ITOUT,FMT=120)
WRITE(IOUT,FMT=110)CELL
IF(ONLINE)WRITE(ITOUT,FMT=110)CELL
ENDIF
call setmat(1,0,0,11)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=100)KCELL,CELL
IF(ONLINE)WRITE(ITOUT,FMT=100)KCELL,CELL
ENDIF
return
endif
C
C---- (2) BAC
C
IF ((KCELL(2) .LT. KCELL(1)) .and. (KCELL(1) .LT. KCELL(3))
$ .AND. (KCELL(2) .LT. KCELL(3))) then
CALL MATMUL3(AMAT,AMATZ,BAC)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=130)
IF(ONLINE)WRITE(ITOUT,FMT=130)
WRITE(IOUT,FMT=110)CELL
IF(ONLINE)WRITE(ITOUT,FMT=110)CELL
ENDIF
call setmat(1,0,0,11)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=100)KCELL,CELL
IF(ONLINE)WRITE(ITOUT,FMT=100)KCELL,CELL
ENDIF
return
endif
C
C---- (3) BCA
C
IF ((KCELL(2) .LT. KCELL(1)) .and. (KCELL(3) .LT. KCELL(1))
$ .AND. (KCELL(2) .LT. KCELL(3))) then
CALL MATMUL3(AMAT,AMATZ,BCA)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=140)
IF(ONLINE)WRITE(ITOUT,FMT=140)
WRITE(IOUT,FMT=110)CELL
IF(ONLINE)WRITE(ITOUT,FMT=110)CELL
ENDIF
call setmat(1,0,0,11)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=100)KCELL,CELL
IF(ONLINE)WRITE(ITOUT,FMT=100)KCELL,CELL
ENDIF
return
endif
C
C---- (4) CAB
C
IF ((KCELL(3) .LT. KCELL(1)) .and. (KCELL(1) .LT. KCELL(2))
$ .AND. (KCELL(3) .LT. KCELL(2))) then
CALL MATMUL3(AMAT,AMATZ,CAB)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=150)
IF(ONLINE)WRITE(ITOUT,FMT=150)
WRITE(IOUT,FMT=110)CELL
IF(ONLINE)WRITE(ITOUT,FMT=110)CELL
ENDIF
call setmat(1,0,0,11)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=100)KCELL,CELL
IF(ONLINE)WRITE(ITOUT,FMT=100)KCELL,CELL
ENDIF
return
endif
C
C---- (5) CBA
C
IF ((KCELL(3) .LT. KCELL(2)) .and. (KCELL(2) .LT. KCELL(1))
$ .AND. (KCELL(3) .LT. KCELL(1))) then
CALL MATMUL3(AMAT,AMATZ,CBA)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=160)
IF(ONLINE)WRITE(ITOUT,FMT=160)
WRITE(IOUT,FMT=110)CELL
IF(ONLINE)WRITE(ITOUT,FMT=110)CELL
ENDIF
call setmat(1,0,0,11)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=100)KCELL,CELL
IF(ONLINE)WRITE(ITOUT,FMT=100)KCELL,CELL
ENDIF
return
endif
C
C check for monoclinic case - ignore b* - swap A & C
C
ELSE IF (ICRYST .EQ. 2) THEN
IF (KCELL(3) .LT. KCELL(1)) THEN
CALL MATMUL3(AMAT,AMATZ,CBA)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=180)
IF(ONLINE)WRITE(ITOUT,FMT=180)
WRITE(IOUT,FMT=110)CELL
IF(ONLINE)WRITE(ITOUT,FMT=110)CELL
ENDIF
call setmat(1,0,0,11)
IF(DEBUG(73))THEN
WRITE(IOUT,FMT=100)KCELL,CELL
IF(ONLINE)WRITE(ITOUT,FMT=100)KCELL,CELL
ENDIF
RETURN
ENDIF
ENDIF
ENDIF
100 FORMAT('DEBUG PERMUTATE:',/,
$ 'User cell is: ',3(F9.4,1X),3(F7.3),/,
$ 'Permuted cell is: ',3(F9.4,1X),3(F7.3))
110 FORMAT('DEBUG PERMUTATE:',/,
$ 'Autoindex cell is: ',3(F9.4,1X),3(F7.3))
120 FORMAT('required cell order is ACB (route 1)')
130 FORMAT('required cell order is BAC (route 2)')
140 FORMAT('required cell order is BCA (route 3)')
150 FORMAT('required cell order is CAB (route 4)')
160 FORMAT('required cell order is CBA (route 5)')
170 FORMAT('required cell order is ABC (no change)')
180 FORMAT('Swapping A and C for monoclinic case')
END
C== PFINDPACK ==
C
C
C
SUBROUTINE PFINDPACK(ID,FILMPLT,NFGEN,JPACK,FORCE,READCC,NOFID)
C ===============================================================
C
C ID pack identifier
C FILMPLT if true, flag the zero level using igflag
C NFGEN number of films in this pack from generate file
C JPACK keeps track of current position in generate file
C FORCE indicates if a 'B' or 'C' film is to be processed
C as an 'A' film.
C READCC if true, reads camera constants and distortion
C parameters from generate file for an "A" film
C NOFID if true, read CCX,CCY,CCOM for A,B, and C films
C
C
C---- This subroutine searches the generate file for film pack ID
C it stores the necessary data from the generate file for
C this pack, ie (IR,IM),X,Y,FLAG
C where flag indicates if this spot is to be measured on
C the basis of the intensity on the previous film and minint
C ipackrec keeps track of position in generate file in 36
C byte records
C
C***** DEBUG(25) for this S/R and PSTART ******
C
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER ID,JPACK,NFGEN
LOGICAL FILMPLT,FORCE,NOFID,READCC
C ..
C .. Local Scalars ..
REAL AMU
INTEGER I,IBULGE,IDG,IERR,INT,ISD,ITILT,ITWIST,J,NC,NRX,NRY,NXS,
+ NYS
LOGICAL TESTINT
CHARACTER CBUFF*88
C ..
C .. Local Arrays ..
REAL RBUF2(45),RBUFF(180)
INTEGER IBUF2(45),IBUFF(180)
INTEGER*2 IBUF3(18)
C ..
C .. External Subroutines ..
EXTERNAL QREAD,QSEEK
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (RBUFF,IBUFF), (IBUFF,CBUFF), (RBUF2,IBUF2)
C ..
SAVE
C
C
C---- Read the next pack header
C
C ***************************
CALL QREAD(IUNIT,IBUF2,180,IERR)
C ***************************
C
IF (IERR.EQ.0) THEN
C
C---- IPACKHEAD is record number of the header of current pack
C
IPACKHEAD = IPACKREC
IPACKREC = IPACKREC + 5
TESTINT = .FALSE.
IDG = IBUF2(1)
TOSPT = IBUF2(2)
TOSPT = IBUF2(3)
AMU = RBUF2(4)
AMU = RBUF2(5)
NFGEN = IBUF2(6)
D1 = RBUF2(19)
D2 = RBUF2(20)
PHI = RBUF2(21)
PSI = RBUF2(22)
C
C
IF (DEBUG(25)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) IDG,TOSPT,NFGEN,D1,D2,PHI,
+ PSI,MINT
WRITE (IOUT,FMT=6000) IDG,TOSPT,NFGEN,D1,D2,PHI,PSI,MINT
END IF
C
C---- If processing did not start with the a film, read in
C camera constants from generate file
C (normally these are passed in common)
C also read these parameters if readcc is true
C
IF ((.NOT.STARTA) .OR. READCC) THEN
CCX = IBUF2(7)
CCY = IBUF2(8)
CCOM = RBUF2(9)
ITILT = IBUF2(12)
ITWIST = IBUF2(13)
IBULGE = IBUF2(14)
CCXABC(1) = CCX
CCYABC(1) = CCY
CCOMABC(1) = PSI
CCXABC(2) = IBUF2(23)
CCYABC(2) = IBUF2(24)
CCOMABC(2) = RBUF2(25)
CCXABC(3) = IBUF2(26)
CCYABC(3) = IBUF2(27)
CCOMABC(3) = RBUF2(28)
C
C
IF (DEBUG(25)) THEN
WRITE (IOUT,FMT=6002) CCXABC,CCYABC,CCOMABC
IF (ONLINE) WRITE (ITOUT,FMT=6002) CCXABC,CCYABC,CCOMABC
WRITE (ITOUT,FMT=6004) ITILT,ITWIST,IBULGE
END IF
C
C
TWIST = ITWIST*FDIST
TILT = ITILT*FDIST
BULGE = IBULGE*FDIST
END IF
C
C
JPACK = JPACK + 1
C
C---- Test pack has been found
C
IF (IDG.NE.ID) THEN
WRITE (IOUT,FMT=6006) ID
IF (ONLINE) WRITE (ITOUT,FMT=6006) ID
ID = -1
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
RETURN
ELSE
C
C---- Correct pack found, store n and m [ n=xg(i), m=yg(i) ]
C set int and sd to -9999
C first test number of reflections (max nrefls)
C
IF (TOSPT.GT.NREFLS) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6008) ID,TOSPT,NREFLS
WRITE (IOUT,FMT=6008) ID,TOSPT,NREFLS
END IF
C
C
DO 10 I = 1,TOSPT
C
C **************************
CALL QREAD(IUNIT,IBUF3,36,IERR)
C **************************
C
IF (IERR.NE.0) THEN
GO TO 20
ELSE
C
C
IF (DEBUG(25) .AND. (I.LE.20)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6010) I, (IBUF3(J),J=1,3),
+ (IBUF3(J),J=5,18)
WRITE (IOUT,FMT=6010) I, (IBUF3(J),J=1,3),
+ (IBUF3(J),J=5,18)
END IF
C
C
XG(I) = IBUF3(5)
YG(I) = IBUF3(6)
C
C---- Set IGFLAG to zero for this reflection.
C
IGFLAG(I) = 0
C
C---- also the intensities of the b (and c) films must be set to
C unmeasured (-9999,-9999) in case this is a repeat measurement,
C when the mint selection criterion might be different to that
C in the original measurement. this is done in wrgen.
C
C---- If not starting with an a film, the intensity and standard
C deviation of the preceeding film must be stored in intg
C and isdg for use in selection of refinement spots in next
C
IF (STARTB) THEN
INT = IBUF3(7)
ISD = IBUF3(8)
ELSE IF (STARTC) THEN
INT = IBUF3(9)
ISD = IBUF3(10)
END IF
C
C
IF (.NOT.STARTA) THEN
IF (DEBUG(25) .AND. I.LE.20) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6012) INT,ISD
WRITE (IOUT,FMT=6012) INT,ISD
END IF
C
C---- Check that there is at least one reflection with intensity
C greater then mint, ie that the previous film in pack has
C already been measured, unless this is to be processed as an
C 'A' film
C
IF (INT.GT.MINT) TESTINT = .TRUE.
INTG(I) = INT
ISDG(I) = ISD
END IF
C
C---- Flag reflections along vectors D1, D2 used to generate the lattice
C
IF (FILMPLT) THEN
IF (IBUF3(5).EQ.0) IGFLAG(I) = 10
IF (IBUF3(6).EQ.0) IGFLAG(I) = 5
END IF
END IF
10 CONTINUE
C
C---- Update ipackrec
C
IPACKREC = IPACKREC + TOSPT
C
C
IF (DEBUG(25)) THEN
WRITE (IOUT,FMT=6014) TOSPT,ID
IF (ONLINE) WRITE (ITOUT,FMT=6014) TOSPT,ID
END IF
C
C---- Check testint (see above) is true
C
IF ((.NOT.STARTA) .AND. (.NOT.TESTINT) .AND.
+ (.NOT.FORCE)) THEN
WRITE (IOUT,FMT=6016)
IF (ONLINE) WRITE (ITOUT,FMT=6016)
ID = -2
C
C---- Reposition file to first pack in generate file
C
C ********************
CALL QSEEK(IUNIT,21,1,36)
C ********************
C
IPACKREC = 21
IPACKHEAD = 21
JPACK = 0
END IF
RETURN
END IF
END IF
C
C---- Error handling for qread
C
20 WRITE (IOUT,FMT=6018) IERR
IF (ONLINE) WRITE (ITOUT,FMT=6018) IERR
STOP
C
C---- Format statements
C
6000 FORMAT (1X,'In PFINDPACK ID=',I4,' TOSPT=',I5,' NFGEN=',I5,/1X,
+ 'D1=',F8.5,' D2=',F8.5,' PHI=',F7.2,' PSI=',F7.2,' MI',
+ 'NT=',I6)
6002 FORMAT (/1X,'NOFID, CCX FOR A,B,C',3I5,/8X,'CCY',10X,3I5,/8X,
+ 'PSI',6X,3F7.2)
6004 FORMAT (2X,'ITILT=',I4,' ITWIST=',I4,' IBULGE=',I4)
6006 FORMAT (///2X,'***** ERROR ***** ',/1X,'Cannot find PACK',I5,' I',
+ 'n this generate file')
6008 FORMAT (2X,'***** PACK',I4,' has',I6,' Reflections but only ',I5,
+ ' are allowed')
6010 FORMAT (1X,'Reflection',I3,3I4,5X,2I6,5X,12I6)
6012 FORMAT (1X,'Intensity and sd stored in INTG and ISDG',2I6)
6014 FORMAT (/1X,'In PACKFIND',I6,' Reflections stored for PACK',I5)
6016 FORMAT (//1X,'***** NO Intensities on the previous film for this',
+ ' pack are greater then MINT *****',/1X,'Consequently NO ',
+ 'SPOTS will be found for refinement',/1X,'Check that the ',
+ 'Previous film has really been measured !!')
6018 FORMAT (//1X,'***** FATAL ERROR IN READING GENERATE FILE *****',
+ /1X,I6,' BYTES Transferred in read')
C
C
END
C== PHITOPSI ==
C
C
C
SUBROUTINE PHITOPSI(PHI,PSI,PH)
C ==============================
C
C---- Convert PHIX,PHIY,PHIZ to PSIX,PSIY,PSIZ at angle PH
C angles in degrees
C
C
C
C .. Scalar Arguments ..
REAL PH
C ..
C .. Array Arguments ..
REAL PHI(3),PSI(3)
C ..
C .. Local Scalars ..
REAL A,B,C11,C21,CP,CP1,CP2,CP3,CPX,CPY,CPZ,PSIX,PSIY,PSIZ,SP,SP1,
+ SP2,SP3,SPX,SPY,SPZ,RPH,DTOR
C ..
C .. Local Arrays ..
REAL RPHI(3)
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN2,COS,SIN,ATAN
C ..
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
DO 10 I = 1,3
RPHI(I) = PHI(I)*DTOR
10 CONTINUE
C
RPH = PH*DTOR
C
CPX = COS(RPHI(1))
CPY = COS(RPHI(2))
CPZ = COS(RPHI(3))
SPX = SIN(RPHI(1))
SPY = SIN(RPHI(2))
SPZ = SIN(RPHI(3))
CP = COS(RPH)
SP = SIN(RPH)
C
C---- Calculate psix
C
SP1 = CP*CPY*SPX - SP*SPY
CP1 = CPX*CPY
PSIX = ATAN2(SP1,CP1)
C
C---- Calculate psiy
C
SP2 = SP*CPY*SPX + CP*SPY
CP2 = CPX*CPY/COS(PSIX)
PSIY = ATAN2(SP2,CP2)
C
C---- Calculate psiz
C
C11 = CP*CPZ*CPY - SP*SPZ*CPY
C21 = SP*CPZ*CPY + CP*SPZ*CPY
A = SIN(PSIY)*SIN(PSIX)*SP + COS(PSIY)*CP
B = COS(PSIX)*SP
SP3 = A*C21 - B*C11
CP3 = A*C11 + B*C21
PSIZ = ATAN2(SP3,CP3)
C
PSI(1) = PSIX/DTOR
PSI(2) = PSIY/DTOR
PSI(3) = PSIZ/DTOR
C
C
END
C== PHTOPS ==
C
C
SUBROUTINE PHTOPS(CPX,SPX,CPY,SPY,CPZ,SPZ,CP,SP,PSI)
C ====================================================
C
C
C---- Convert phix,phiy,phiz to psix,psiy,psiz
C angles in degrees!!!
C
C
C---- Calculate psix
C
C .. Scalar Arguments ..
REAL CP,CPX,CPY,CPZ,SP,SPX,SPY,SPZ
C ..
C .. Array Arguments ..
REAL PSI(3)
C ..
C .. Local Scalars ..
REAL A,B,C11,C21,CP1,CP2,CP3,PSIX,PSIY,PSIZ,SP1,SP2,SP3,DTOR
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN2,COS,SIN,ATAN
C ..
SAVE
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
SP1 = CP*CPY*SPX - SP*SPY
CP1 = CPX*CPY
PSIX = ATAN2(SP1,CP1)
C
C---- Calculate psiy
C
SP2 = SP*CPY*SPX + CP*SPY
CP2 = CPX*CPY/COS(PSIX)
PSIY = ATAN2(SP2,CP2)
C
C---- Calculate psiz
C
C11 = CP*CPZ*CPY - SP*SPZ*CPY
C21 = SP*CPZ*CPY + CP*SPZ*CPY
A = SIN(PSIY)*SIN(PSIX)*SP + COS(PSIY)*CP
B = COS(PSIX)*SP
SP3 = A*C21 - B*C11
CP3 = A*C11 + B*C21
PSIZ = ATAN2(SP3,CP3)
C
PSI(1) = PSIX/DTOR
PSI(2) = PSIY/DTOR
PSI(3) = PSIZ/DTOR
C
C
END
C== PICKSPOTS ==
SUBROUTINE PICKSPOTS(MODE,LPRNT,SIGAVG,BOXOPEN2,ISTAT)
C =====================================================
C
IMPLICIT NONE
C
C
C---- This is the subroutine that controls the spot search.
C Spots that pass the various size tests are transferred into arrays
C XSPT,YSPT,ISPT in /SPOTS/ for display.
C
C MODE = 0,1 Search for spots and select as usual
C = 2 Do not search, repeat selection of existing list
C
C If MODE GE 10 then PICKSPOTS simply sets a new threshold
C and returns.
C
C = 10 Prelim search to determine best threshold, separation
C and raster box size
C = 20 Prelim search to determine best threshold, separation
C and raster box size, do not go on to search for spots.
C
C ISTAT = 0 no errors
C = -1 not enough spots for threshold determination
C = -2 No spots found !
C = -3 Too many spots found (threshold too low)
C = -4 Too many spots to store
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE,ISTAT
REAL SIGAVG
LOGICAL LPRNT,BOXOPEN2
C ..
C .. Local Scalars ..
REAL FRACT,PI,RSPOTMAX,THETA,WBINR2,WBINT,WXMAX,WXMIN,WXMM,
+ WYMAX,WYMIN,WYMM,XMM,XS,YMM,YS,X,XADD,YADD,XF1,YF1,
+ COMEGAF,SOMEGAF,DTR,XCP,OMEGAFD,ARMAXSP,BKGTOT,BKG,
+ ARMINSP,TEMP
INTEGER I,IFRIG,IR,IT,J,MINPIX,IXW,IYW,LINELEN,NUMLIN,
+ NREJBIGX,NREJBIGY,NREJSMALLX,NREJSMALLY,NSPOT,NWRITE,
+ ISWUNG,NPREV,NREJOV,INTTOT,NPXTOT,NUSED,IERRF,NXLIM,
+ NYLIM,MODEDISP
CHARACTER LINE*80
LOGICAL NEW,LIST
C ..
C .. Local Arrays ..
INTEGER ICOUNT(16,5)
C ..
C .. External Subroutines ..
EXTERNAL FINDSPOTS,SORTUP,SORTUP4,OVERLAPSP,DSPSPT
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN,ATAN2,INT,MAX,MIN
C ..
C .. Common blocks ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/findspots.f
c findspots.f header (include) file
c to pass information about the number of spots found about
c and to store the default parameters...
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c values used to pass the spot finding results
integer fs_found, fs_used, fs_rejected, fs_xmin, fs_xmax,
$ fs_ymin, fs_ymax, fs_separation, fs_pixels
c values used to store the default parameter set
integer fs_thresh, fs_rminsp, fs_rmaxsp, fs_xsplit,
$ fs_ysplit, fs_cutwxmin, fs_cutwxmax, fs_cutwymin,
$ fs_cutwymax, fs_npixmin, fs_xoffset, fs_yoffset
logical fs_radx, fs_rady
common /fndspts/ fs_found, fs_used, fs_rejected, fs_xmin,
$ fs_xmax, fs_ymin, fs_ymax, fs_separation, fs_pixels,
$ fs_thresh, fs_rminsp, fs_rmaxsp, fs_xsplit,
$ fs_ysplit, fs_cutwxmin, fs_cutwxmax, fs_cutwymin,
$ fs_cutwymax, fs_npixmin, fs_xoffset, fs_yoffset,
$ fs_radx, fs_rady
C&&*&& end_include ../inc/findspots.f
C ..
SAVE
C .. Data statements ..
DATA FRACT/0.5/
C ..
C
C
DTR = ATAN(1.0)/45.0
OMEGAFD = OMEGAF/DTR
NEW = .TRUE.
LIST = DEBUG(62)
PI = ATAN(1.0)*4.0
ISTAT = 0
C
C---- Zero counter for spots in each bin
C
DO 20 I = 1,NBINR
DO 10 J = 1,NBINT
ICOUNT(J,I) = 0
10 CONTINUE
20 CONTINUE
C
C---- Assign NPREV, pointer to last stored spot, but not if MODE.>= 10
C as spot coords are not stored in this case.
C
IF (MODE.LT.10) THEN
IF (NIMAG.EQ.1) THEN
NPREV = 0
ELSE
NPREV = IENDIMG(NIMAG-1)
END IF
END IF
WXMM = XSPLIT
WYMM = YSPLIT
XMM = 0.01*XCEN
YMM = 0.01*YCEN
MINPIX = NPIXMIN
ARMAXSP = ABS(RMAXSP)
ARMINSP = ABS(RMINSP)
IF (MODE.GE.10) THEN
ARMAXSP = ABS(RMAXSRCH)
ARMINSP = ABS(RMINSRCH)
END IF
IF (DEBUG(62)) THEN
WRITE(IOUT,FMT=6020) MODE,XMM,YMM,ARMINSP,ARMAXSP,NPREV
IF (ONLINE) WRITE(ITOUT,FMT=6020) MODE,XMM,YMM,ARMINSP,ARMAXSP,
+ NPREV
6020 FORMAT(1X,'In PICKSPOTS',/,1X,'MODE=',I3,' spot search ',
+ 'centred on',2F8.2,'mm, inner, outer radii',2F8.2,'mm',/,1X,
+ 'NPREV=',I5)
END IF
IF (MODE.EQ.2) GOTO 24
C
C ***********************************************************
CALL FINDSPOTS(XMM,YMM,ARMINSP,ARMAXSP,WXMM,WYMM,MINPIX,NSPOT,
+ LPRNT,IERRF)
C call dpssearch(xmm,ymm,ARMINSP,ARMAXSP,nspot,ierrf)
C ***********************************************************
C
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
IF (IERRF.EQ.1) THEN
ISTAT = -3
RETURN
END IF
C
IF (NSPOT.EQ.0) THEN
WRITE(IOUT,FMT=6040)
6040 FORMAT(//,1X,' ** No spots found on image !!')
IF (ONLINE) WRITE(ITOUT,FMT=6040)
ISTAT = -2
RETURN
END IF
C
C---- Ensure enough spots found for threshold determination
C
IF (NSPOT.LT.NSEARCH) THEN
ISTAT = -1
RETURN
END IF
C
C---- New style spots file follows
C
IF (NEW) THEN
IF (INVERTX) THEN
XCP = NREC*RAST - XMM
ELSE
XCP = XMM
END IF
ELSE
C
C---- Write out "pseudo fiducials" for image plates
C First the camera constants (zero), then give fiducials 1 and 3
C the direct beam coordinates as specified by XC,YC
C
XF = 0.0
YF = 0.0
C
C----- Note that for the direct beam coordinates we
C need to transform the input XC,YC to the MOSFLM detector frame
C which has X parallel to scanner Y and Y antiparallel to scanner X.
C The coordinates written out are wrt an origin NOT at the direct beam
C position, but at 2*XC,0 in the scanner frame. In REFIX or IDXREF
C an origin shift is applied by subtracting the coordinates of the
C direct beam position (midpoint of fiducials 1 and 3) from all
C spot coordinates.
C
XADD = 0.0
YADD = 0.0
IF (ABS(OMEGAFD-90.0).LT.0.1) THEN
YADD = 2*XMM
ELSE IF (ABS(OMEGAFD-180.0).LT.0.1) THEN
XADD = 2*XMM
YADD = 2*YMM
ELSE IF (ABS(OMEGAFD-270.0).LT.0.1) THEN
XADD = 2*YMM
END IF
C
COMEGAF = COS(OMEGAF)
SOMEGAF = SIN(OMEGAF)
XF1 = XADD + XMM*COMEGAF + YMM*SOMEGAF
YF1 = YADD - XMM*SOMEGAF + YMM*COMEGAF
C
END IF
C
C
C Test for acceptable spots
C
C Try to reject "false" spots (eg ice spots, small twin component etc)
C To do this we find the median widths and then reject those
C spots that are either too small or too big relative to the
C median spot size.
C
C---- Note that this uses ALL found spots, and does not impose the RMIN
C test. This is NOT good !Median spot size is
C
C---- Sort spots on width in x
C
C ********************************
CALL SORTUP4(NSPOT,IWXSPOT,IORDER)
C ********************************
C
C---- Determine median x width and use it to set cutoffs
C
I = INT(NSPOT*0.6)
IF (I.LT.1) I = 1
MEDWXSPOT = IWXSPOT(IORDER(I))
C
C---- Sort spots on width in Y
C
C ********************************
CALL SORTUP4(NSPOT,IWYSPOT,IORDER)
C ********************************
C
C---- Determine median Y width and use it to set cutoffs
C
I = INT(NSPOT*0.6)
IF (I.LT.1) I = 1
MEDWYSPOT = IWYSPOT(IORDER(I))
C
IF (LPRNT.OR.(DEBUG(62))) WRITE(IOUT,FMT=6000)MEDWXSPOT,MEDWYSPOT
IF (ONLINE.AND.(LPRNT.OR.(DEBUG(62)))) WRITE(ITOUT,FMT=6000)
+ MEDWXSPOT,MEDWYSPOT
6000 FORMAT (/2X,'Median spot size is',I4,' x',I4,' pixels')
C
C---- Check for "overlapping" spots
C
CALL OVERLAPSP(NSPOT,NREJOV)
C
C---- Sort all spots on intensity
C
C **************************
CALL SORTUP4(NSPOT,INSPOT,IORDER)
C **************************
C
C---- Start here if just repeating selection
C
24 WXMIN = MEDWXSPOT*CUTWXMIN
WXMAX = MEDWXSPOT*CUTWXMAX
C
WYMIN = MEDWYSPOT*CUTWYMIN
WYMAX = MEDWYSPOT*CUTWYMAX
C
NREJBIGX = 0
NREJSMALLX = 0
C
NREJBIGY = 0
NREJSMALLY = 0
NXLIM = 0
NYLIM = 0
C
C---- Find actual maximum radius for binning purposes
C
RSPOTMAX = 0.0
C
C
DO 30 I = 1,NSPOT
IF (IWXSPOT(I).LT.WXMIN) GO TO 30
IF (IWXSPOT(I).GT.WXMAX) GO TO 30
IF (IWYSPOT(I).LT.WYMIN) GO TO 30
IF (IWYSPOT(I).GT.WYMAX) GO TO 30
RSPOTMAX = MAX(RSPOTMAX,RSPOT(I))
30 CONTINUE
C
C---- Calculate widths of bins
C
IF (DEBUG(62)) THEN
WRITE(IOUT,FMT=6030) RSPOTMAX,NBINR,NBINT,WXMIN,
+ WXMAX,WYMIN,WYMAX
IF (ONLINE) WRITE(ITOUT,FMT=6030) RSPOTMAX,NBINR,NBINT,WXMIN,
+ WXMAX,WYMIN,WYMAX
6030 FORMAT(1X,'RSPOTMAX',F12.1,' NBINR',I3,' NBINT',I3,' WXMIN',
+ F6.1,' WXMAX',F6.1,' WYMIN',F6.1,' WYMAX',F6.1)
END IF
WBINR2 = (RSPOTMAX**2)/NBINR
WBINT = 2*PI/NBINT
NWRITE = 0
IF (LIST) WRITE(IOUT,FMT=6002)
6002 FORMAT (/6X,'X',7X,'Y',8X,'R',4X,'Intensity',2X,'Pixels WX ',
+ ' WY')
C
C---- Loop over spots starting with the strongest
C Write out the strongest IBINLIM spots in each bin
C
INTTOT = 0
NPXTOT = 0
BKGTOT = 0.0
NUSED = 0
C
DO 40 I = NSPOT,1,-1
J = IORDER(I)
IF (DEBUG(62).AND.((NSPOT-I).LE.500)) THEN
WRITE(IOUT,FMT=6032) I,J,XSPOT(J),YSPOT(J),RSPOT(J),
+ INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
IF (ONLINE) WRITE(ITOUT,FMT=6032) I,J,XSPOT(J),YSPOT(J),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
END IF
6032 FORMAT(1X,2I5,3F6.1,I10,I5,2I3)
IF (RSPOT(J).LT.RMINSP) GO TO 40
IF (IWXSPOT(J).LT.WXMIN) THEN
NREJSMALLX = NREJSMALLX + 1
IF (LIST) WRITE(ITOUT,FMT=6004)(XSPOT(J)-XMM),(YSPOT(J)-YMM),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
IF (LIST) WRITE(IOUT,FMT=6004)(XSPOT(J)-XMM),(YSPOT(J)-YMM),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
6004 FORMAT (1X,2F8.2,2X,F7.2,2X,F7.0,2X,I6,2X,2I6,' REJECTED')
GO TO 40
ELSE IF (IWYSPOT(J).LT.WYMIN) THEN
NREJSMALLY = NREJSMALLY + 1
IF (LIST) WRITE(ITOUT,FMT=6004)(XSPOT(J)-XMM),(YSPOT(J)-YMM),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
GO TO 40
ELSE IF (IWXSPOT(J).GT.WXMAX) THEN
NREJBIGX = NREJBIGX + 1
IF (LIST) WRITE(ITOUT,FMT=6004)(XSPOT(J)-XMM),(YSPOT(J)-YMM),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
GO TO 40
ELSE IF (IWYSPOT(J).GT.WYMAX) THEN
NREJBIGY = NREJBIGY + 1
IF (LIST) WRITE(ITOUT,FMT=6004)(XSPOT(J)-XMM),(YSPOT(J)-YMM),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
GO TO 40
ELSE IF (ABS(XSPOT(J)-XMM).LT.SPXMIN) THEN
NXLIM = NXLIM + 1
GOTO 40
ELSE IF (ABS(YSPOT(J)-YMM).LT.SPYMIN) THEN
NYLIM = NYLIM + 1
GOTO 40
END IF
C
C
IF (MODE.GE.10) THEN
if (npix(j).le.0)npix(j)=49
IF (DEBUG(62)) WRITE(6,*)'INSPOT,NPIX',INSPOT(J),NPIX(J)
INTTOT = INTTOT + INSPOT(J)
NPXTOT = NPXTOT + NPIX(J)
BKG = ((REAL(ISDSPOT(J)))**2 -
+ GAIN*INSPOT(J))/(NPIX(J)*GAIN)
BKGTOT = BKGTOT + BKG
NUSED = NUSED + 1
IF (NUSED.EQ.NSEARCH) GOTO 44
GOTO 40
END IF
C
C---- Find radial bin
C
IR = MIN(NBINR,INT(RSPOT(J)**2/WBINR2+1.0))
C
C---- Find theta bin
C
XS = XSPOT(J) - XMM
YS = YSPOT(J) - YMM
THETA = ATAN2(YS,XS)
IT = MIN(NBINT,INT((THETA+PI)/WBINT+1.0))
C
C---- Increment counter
C
ICOUNT(IT,IR) = ICOUNT(IT,IR) + 1
C
IF (ICOUNT(IT,IR).LE.IBINLIM) THEN
C
IF (NEW) THEN
IF (INVERTX) THEN
XF = NREC*RAST - XSPOT(J)
ELSE
XF = XSPOT(J)
END IF
YF = YSPOT(J)/YSCAL
C
C---- Transfer spot coordinates and intensities in arrays XSPT,YSPT,ISPT
C Test for negative intensity of "overlapped" spots
C Note that XSPT,YSPT are in true mm, not "pixel mm", ie Y coordinates
C have been corrected by YSCAL
C
IF ((NWRITE+NPREV.LT.NSPOTS).AND.(INSPOT(J).GT.0)) THEN
NWRITE = NWRITE + 1
XSPT(NWRITE+NPREV) = XSPOT(J)
YSPT(NWRITE+NPREV) = YF
ISPT(NWRITE+NPREV) = INSPOT(J)
ISDSPT(NWRITE+NPREV) = MAX(ISDSPOT(J),1)
ELSE
C
C---- Set error flag, too many spots to store
C
IF (NWRITE+NPREV.GE.NSPOTS) ISTAT = -4
END IF
ELSE
XF = XADD + XSPOT(J)*COMEGAF + YSPOT(J)*SOMEGAF/YSCAL
YF = YADD - XSPOT(J)*SOMEGAF + YSPOT(J)*COMEGAF/YSCAL
END IF
C
IF (LIST) WRITE(ITOUT,FMT=6006)(XSPOT(J)-XMM),(YSPOT(J)-YMM),
+ RSPOT(J),INSPOT(J),NPIX(J),IWXSPOT(J),IWYSPOT(J)
6006 FORMAT (1X,2F8.2,2X,F7.2,2X,I7,2X,I6,2X,2I6)
END IF
40 CONTINUE
C
C---- If threshold supplied, do no recalculate it
C
44 IF (MODE.EQ.30) RETURN
IF (MODE.GE.10) THEN
CAL INTTOT = INTTOT/NPXTOT
if(nused.eq.0)nused=1
INTTOT = INTTOT/(NUSED*MEDWXSPOT*MEDWYSPOT)
BKG = BKGTOT/REAL(NUSED)
IF (DEBUG(62))
+ WRITE(6,*)'nsearch,mean I per pix, mean bkg',NUSED,INTTOT,BKG
X = SCALSRCH*INTTOT
X = GAIN*(X/SIGAVG)*0.001*(BKG-THRESH*SIGAVG)
C
C---- Ensure THRESH is always 4 or more
C
X = MAX(X,0.0)
THRESH = X + 4.0
C
C---- Make sure that this is above the minimum threshold set if there
C were too many spots found
C
THRESH = MAX(THRESH,THRESHMIN)
C
C---- Do not allow threshold to exceed THRESHMAX
C
TEMP = THRESH
THRESH = MIN(THRESH,THRESHMAX)
IF (TEMP.LE.THRESH) THEN
WRITE(IOUT,FMT=6012) THRESH
IF (ONLINE) WRITE(ITOUT,FMT=6012) THRESH
6012 FORMAT(1X,'Threshold set to',F7.1)
IF (DEBUG(62)) WRITE(6,*)'SIGAVG,THRESH',SIGAVG,THRESH
ELSE
WRITE(IOUT,FMT=6013) TEMP,THRESH
IF (ONLINE) WRITE(ITOUT,FMT=6013) TEMP,THRESH
6013 FORMAT(1X,'Threshold calculated as',F7.1,' but reset to',F7.1,
+ /,1X,'(This limit set by keywords FINDSPOTS THRESHMAX.)')
END IF
RETURN
END IF
C
c save the values for the spot search, so that they can be returned
fs_found = NSPOT
fs_xmin = NREJSMALLX
fs_xmax = NREJBIGX
fs_ymin = NREJSMALLY
fs_ymax = NREJBIGY
fs_xsplit = NREJOV
fs_ysplit = NREJOV
fs_used = NWRITE
IF (BRIEF) THEN
WRITE (IBRIEF,FMT=6000) MEDWXSPOT,MEDWYSPOT
WRITE (IBRIEF,FMT=6008) NSPOT,NREJSMALLX,NREJSMALLY,NREJBIGX,
+ NREJBIGY,NREJOV,NWRITE
END IF
IF (LPRNT) WRITE(IOUT,FMT=6008) NSPOT,NREJSMALLX,NREJSMALLY,
+ NREJBIGX,NREJBIGY,NREJOV,NWRITE
IF (ONLINE.AND.LPRNT) WRITE(ITOUT,FMT=6008) NSPOT,NREJSMALLX,
+ NREJSMALLY,NREJBIGX,NREJBIGY,NREJOV,NWRITE
6008 FORMAT (/2X,
+ 'Total number of spots found:',I4,/,2X,
+ 'Number rejected as too small on X:',I4,/,2X,
+ 'Number rejected as too small on Y:',I4,/,2X,
+ 'Number rejected as too big on X:',I4,/,2X,
+ 'Number rejected as too big on Y:',I4,/,2X,
+ 'Number too close (SEPARATION keyword):',I4,/,2X,
+ 'Number stored as OK:',I4,//)
C
C---- Now output to window (if open)
C
IF (WINOPEN.AND.LHELP) THEN
IF (.NOT.BOXOPEN2) THEN
C
C Create IO window
C
IXW = 200
IYW = 200
LINELEN = 56
NUMLIN = 10
CALL MXDCIO(0,LINELEN, NUMLIN, IXW,IYW)
BOXOPEN2 = .TRUE.
END IF
LINE = ' '
WRITE(LINE,FMT=6048) THRESH
6048 FORMAT('Threshold for spot finding set to',F6.1)
CALL MXDWIO(LINE,3)
LINE = ' '
WRITE(LINE,FMT=6050) NSPOT
CALL MXDWIO(LINE, 3)
6050 FORMAT('Total number of spots found:',I4)
LINE = ' '
WRITE(LINE,FMT=6052) NREJSMALLX
CALL MXDWIO(LINE, 2)
6052 FORMAT('Number rejected as too small on X:',I4)
LINE = ' '
WRITE(LINE,FMT=6054) NREJSMALLY
CALL MXDWIO(LINE, 2)
6054 FORMAT('Number rejected as too small on Y:',I4)
LINE = ' '
WRITE(LINE,FMT=6056) NREJBIGX
CALL MXDWIO(LINE, 2)
6056 FORMAT('Number rejected as too big on X:',I4)
LINE = ' '
WRITE(LINE,FMT=6058) NREJBIGY
CALL MXDWIO(LINE, 2)
6058 FORMAT('Number rejected as too big on Y:',I4)
LINE = ' '
WRITE(LINE,FMT=6060) 0.01*IXSEP,0.01*IYSEP,NREJOV
CALL MXDWIO(LINE, 2)
6060 FORMAT('Number too close (SEPARATION keyword, now',2F4.1,'):',
+ I4)
LINE = ' '
WRITE(LINE,FMT=6062) NWRITE
CALL MXDWIO(LINE, 2)
6062 FORMAT('Number stored as OK:',I4)
C
C....Try displaying spots here
NSPT = MIN(NWRITE,NSPOTS)
ISTIMG(NIMAG) = NPREV + 1
IENDIMG(NIMAG) = MIN(NPREV +NWRITE ,NSPOTS)
C
C---- Display all spots
C
MODEDISP = 0
CALL DSPSPT(MODEDISP)
C
ELSE
C
C---- If not LHELP
C....Try displaying spots here
NSPT = MIN(NWRITE,NSPOTS)
ISTIMG(NIMAG) = NPREV + 1
IENDIMG(NIMAG) = MIN(NPREV +NWRITE ,NSPOTS)
MODEDISP = 0
CALL DSPSPT(MODEDISP)
END IF
C
C---- Skip this if online
C
IF (ONLINE) RETURN
C
IF (LPRNT) WRITE(IOUT,FMT=6010)
IF (ONLINE.AND.LPRNT) WRITE(ITOUT,FMT=6010)
6010 FORMAT (/13X,'Number of spots found in each bin')
C
C
DO 50 J = 1,NBINR
IF (LPRNT) WRITE(IOUT,FMT='(12X,12I4)') (ICOUNT(I,J),I=1,NBINT)
IF (ONLINE.AND.LPRNT) WRITE(ITOUT,FMT='(12X,12I4)')
+ (ICOUNT(I,J),I=1,NBINT)
50 CONTINUE
C
C
RETURN
END
C== PIXLIST ==
C
C
C
SUBROUTINE PIXLIST(MASK,LRAS,LISTPIX)
C =====================================
C
C
C
C
C---- Find the pixel numbers of the central 9 peak pixels for each
C raster box expansion
C
C
C
C .. Array Arguments ..
INTEGER LISTPIX(9),LRAS(5),MASK(*)
C ..
C .. Local Scalars ..
INTEGER I,IPX,J,K,NP,NPTS,NSTOP,NX,NXY,NY
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
C
SAVE
C
NX = LRAS(1)
NY = LRAS(2)
NXY = NX*NY
NP = 0
C
C---- Find central 9 points
C
IPX = (NXY+1)/2 - 1 - NY
C
C
DO 70 I = 1,3
DO 60 J = 1,3
NP = NP + 1
LISTPIX(NP) = IPX
IPX = IPX + 1
60 CONTINUE
C
C
IPX = IPX + NY - 3
70 CONTINUE
C
C
IF (DEBUG(23)) THEN
WRITE (IOUT,FMT=6000) NX,NY, (LISTPIX(K),K=1,9)
IF (ONLINE) WRITE (ITOUT,FMT=6000) NX,NY, (LISTPIX(K),K=1,9)
END IF
C
C---- Format statements
C
6000 FORMAT (1X,'List of central peak pixel numbers wi',
+ 'th NXX=',I2,' NYY=',I2,/2 (1X,9I4,/))
C
C
END
C== PIXOVERLAP ==
SUBROUTINE PIXOVERLAP(MODE,LMASK,NXX,NYY,HX,HY)
C
IMPLICIT NONE
C
C MODE = 1 Sets array LMASK to -1 for all pixels that have any
C neighbours that are overlapped pixels (flagged with
C LMASK value of zero)
C
C = 2 Set LMASK to -1 as for MODE=1, then set pixels which
C were previously OK but are adjacent to -1 pixels to -2.
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NXX,NYY,HX,HY,MODE
C ..
C .. Array Arguments ..
INTEGER LMASK(MAXBOX)
C ..
C .. Local Scalars ..
INTEGER I,J,IJ
LOGICAL XOK
C ..
C .. Local Arrays ..
INTEGER MASK(-MXDOV2-1:MXDOV2+1,-MXDOV2-1:MXDOV2+1)
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
C ..
C
C---- Set up MASK to equal LMASK within measurement box and 99 outside it
C
IJ = 0
DO 10 I = -HX-1, HX+1
XOK = ((I.GT.(-HX-1)).AND.(I.LT.(HX+1)))
DO 12 J = -HY-1, HY+1
MASK(J,I) = 99
IF (XOK.AND.((J.GT.(-HY-1)).AND.(J.LT.(HY+1)))) THEN
IJ = IJ + 1
MASK(J,I) = LMASK(IJ)
C
C---- Set flag for both overlapped peak and background pixels to 0.
C Input array LMASK has values of 2 for overlapped peak pixels.
C
IF (MASK(J,I).EQ.2) MASK(J,I) = 0
END IF
12 CONTINUE
10 CONTINUE
C
C---- Now test all non-overlapped pixels for a neighbouring overlapped one.
IJ = 0
DO 40 I = -HX,HX
DO 30 J = -HY,HY
IJ = IJ + 1
C
C---- Skip if this is a overlappped pixel
C
IF ((LMASK(IJ).EQ.0).OR.(LMASK(IJ).EQ.2)) GOTO 30
C
C---- Test all 8 neighbours
C
IF ((MASK(J-1,I-1).EQ.0).OR.
+ (MASK(J,I-1).EQ.0).OR.(MASK(J+1,I-1).EQ.0).OR.
+ (MASK(J-1,I).EQ.0).OR.(MASK(J+1,I).EQ.0).OR.
+ (MASK(J-1,I+1).EQ.0).OR.(MASK(J,I+1).EQ.0).OR.
+ (MASK(J+1,I+1).EQ.0)) LMASK(IJ) = -1
30 CONTINUE
40 CONTINUE
IF (MODE.EQ.1) RETURN
C
C---- Now set up MASK to -1 where LMASK is -1
C
IJ = 0
DO 60 I = -HX-1, HX+1
XOK = ((I.GT.(-HX-1)).AND.(I.LT.(HX+1)))
DO 50 J = -HY-1, HY+1
IF (XOK.AND.((J.GT.(-HY-1)).AND.(J.LT.(HY+1)))) THEN
IJ = IJ + 1
IF (LMASK(IJ).EQ.-1) MASK(J,I) = -1
END IF
50 CONTINUE
60 CONTINUE
C
C---- Now test all OK pixels for a neighbouring pixel flagged with -1
C
IJ = 0
DO 80 I = -HX,HX
DO 70 J = -HY,HY
IJ = IJ + 1
C
C---- Skip if this not an OK pixel
C
IF (LMASK(IJ).NE.1) GOTO 70
C
C---- Test all 8 neighbours
C
IF ((MASK(J-1,I-1).EQ.-1).OR.
+ (MASK(J,I-1).EQ.-1).OR.(MASK(J+1,I-1).EQ.-1).OR.
+ (MASK(J-1,I).EQ.-1).OR.(MASK(J+1,I).EQ.-1).OR.
+ (MASK(J-1,I+1).EQ.-1).OR.(MASK(J,I+1).EQ.-1).OR.
+ (MASK(J+1,I+1).EQ.-1)) LMASK(IJ) = -2
70 CONTINUE
80 CONTINUE
END
C== PKRIM ==
SUBROUTINE PKRIM(OD,CTOT,IHX,IHY,IMODE,NRXMIN,NRYMIN,NCMIN)
C =========================================================
C IMPLICIT NONE
C
C---- By searching from the centre of the measurement box, determine
C the extent of the spot along X,Y and diagonals, to ensure that
C neighbouring spots are not included as part of the peak during
C profile optimisation
C
C CTOT Total background subtracted when dealing with averaged
C profiles
C IMODE = 0 Only need to find significant next peak on one side
C of origin. This is used when called from CENTRS.
C = 1 Need to find significant next peak on both sides
C of origin. This is used when called for standard profiles.
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IHX,IHY,NRXMIN,NRYMIN,NCMIN,IMODE
REAL CTOT
C ..
C .. Array Arguments ..
INTEGER OD(-IHY:IHY,-IHX:IHX)
C ..
C .. Local Scalars ..
INTEGER I,IJ,IHMIN,NEDGE,NCMIN1,NCMIN2,NXS,NYS,MAXPIX
C ..
C .. Local Arrays ..
INTEGER ISTRIP(MAXDIM),IOD(3)
C ..
C .. External Subroutines ..
EXTERNAL FEDGE,ODPLOT4
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C
C
MAXPIX = 0
NXS = 2*IHX + 1
NYS = 2*IHY + 1
IF (DEBUG(47)) THEN
WRITE(IOUT,FMT=6000) CTOT
IF (ONLINE) WRITE(ITOUT,FMT=6000) CTOT
6000 FORMAT(//1X,'PKRIM, CTOT is ',F9.0,' Input box')
CALL ODPLOT4(OD,NXS,NYS,1,MAXPIX)
END IF
C
C
C---- Transfer the stripe of pixel values along X through centre of
C peak into ISTRIP
C
IJ = 0
DO 10 I = -IHX,IHX
IJ = IJ + 1
ISTRIP(IJ) = OD(0,I) + CTOT
10 CONTINUE
C
C---- Now find the next peak (if any) in this direction
C
CALL FEDGE(ISTRIP,IHX,IMODE,NEDGE)
NRXMIN = IHX - NEDGE + 1
C
C---- Now repeat the procedure in Y direction
C Transfer the stripe of pixel values along Y through centre of
C peak into ISTRIP
C
IJ = 0
DO 20 I = -IHY,IHY
IJ = IJ + 1
ISTRIP(IJ) = OD(I,0) + CTOT
20 CONTINUE
C
C---- Now find the next peak (if any) in this direction
C
CALL FEDGE(ISTRIP,IHY,IMODE,NEDGE)
NRYMIN = IHY - NEDGE + 1
C
C---- Now repeat the procedure in Positive gradient diagonal direction
C Transfer the stripe of pixel values along Y through centre of
C peak into ISTRIP
C
IJ = 0
IHMIN = MIN(IHX,IHY)
DO 30 I = -IHMIN,IHMIN
IJ = IJ + 1
ISTRIP(IJ) = OD(I,I) + CTOT
30 CONTINUE
C
C---- Now find the next peak (if any) in this direction
C
CALL FEDGE(ISTRIP,IHMIN,IMODE,NEDGE)
NCMIN1 = IHX + IHY - 2*NEDGE
C
C---- Now repeat the procedure in Negative gradient diagonal direction
C Transfer the stripe of pixel values along Y through centre of
C peak into ISTRIP
C
IJ = 0
DO 40 I = -IHMIN,IHMIN
IJ = IJ + 1
ISTRIP(IJ) = OD(-I,I) + CTOT
40 CONTINUE
C
C---- Now find the next peak (if any) in this direction
C
CALL FEDGE(ISTRIP,IHMIN,IMODE,NEDGE)
NCMIN2 = IHX + IHY - 2*NEDGE
C
C---- Originally NCMIN was set to the SMALLER of NCMIN1, NCMIN2 !
C
NCMIN = MAX(NCMIN1,NCMIN2)
IF (DEBUG(47)) THEN
WRITE(IOUT,FMT=6004) NRXMIN,NRYMIN,NCMIN1,NCMIN2
IF (ONLINE) WRITE(ITOUT,FMT=6004) NRXMIN,NRYMIN,NCMIN1,NCMIN2
6004 FORMAT(//1X,'NRXMIN=',I2,' NRYMIN=',I2,' NCMIN1=',I2,
+ ' NCMIN2=',I2)
END IF
END
C== PLOTPROF ==
SUBROUTINE PLOTPROF(OD,IPROFL,IRAS,MASK,PROFSUMS,WPROFSUMS,
+ MASKREJO,MASKREJP,LMASKREJP,WEIGHT,PKONLY)
C =======================================================
C
C---- Print reflection, scaled profile and the difference for individual
C reflections selected using the DUMP option
C
C MASKREJO Array containing list of rejected background pixels
C because they are outliers. This is set up in EVAL
C and passed back to PROCESS.
C
C MASKREJP Array containing list of rejected peak pixels
C due to overlap of neighbouring spots (from MASKIT).
C
C LMASKREJP Array containing list of rejected peak pixels
C due to very poor profile fit. This is set up in this
C INTEG2 and passed back to PROCESS.
C
C
IMPLICIT NONE
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
LOGICAL WEIGHT,PKONLY
C ..
C .. Array Arguments ..
REAL PROFSUMS(4),WPROFSUMS(4)
INTEGER IRAS(5),MASK(MAXBOX),OD(MAXBOX),IPROFL(MAXBOX),
+ MASKREJO(NREJMAX),MASKREJP(NREJMAX),LMASKREJP(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,APC,B,C,XJ,WT,WDEL
INTEGER HX,HY,IJ,NX,NY,P,Q,IDR,MAXPIX
C ..
C .. Local Arrays ..
INTEGER ODX(MAXBOX),PRX(MAXBOX),DIFF(MAXBOX),IWDEL(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL ODPLOT4R
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C
C
SAVE
C ..
C
IDR = 1
HX = IRAS(1)/2
HY = IRAS(2)/2
A = ASPOT(9)
B = ASPOT(10)
C = ASPOT(11)
XJ = ASPOT(13)/PROFSUMS(3)
IF (WEIGHT) XJ = ASPOT(13)/WPROFSUMS(3)
IF (PKONLY) XJ = ASPOT(13)/PROFSUMS(3)
IJ = 0
NX = IRAS(1)
NY = IRAS(2)
C
C
DO 20 P = -HX,HX
APC = A*P + C
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
C
ODX(IJ) = NINT(OD(IJ) - (APC + B*Q))
PRX(IJ) = NINT(IPROFL(IJ) * XJ)
DIFF(IJ) = ODX(IJ) - PRX(IJ)
C
C---- Weighted difference
C
WT = GAIN*(PRX(IJ) + APC + B*Q)
IF (WT.LT.0) WT = 0.0
IF (WT.GT.0.0) WT = 1.0/WT
WDEL = SQRT(WT)*DIFF(IJ)
IWDEL(IJ) = NINT(WDEL)
C
C
10 CONTINUE
20 CONTINUE
C
C
WRITE(IOUT,6000)
IF (ONLINE) WRITE(ITOUT,6000)
6000 FORMAT(/1X, ' Original pixel values')
MAXPIX = 0
CALL ODPLOT4R(OD,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
WRITE(IOUT,6002)
IF (ONLINE) WRITE(ITOUT,6002)
6002 FORMAT(/1X, ' Background substracted values')
CALL ODPLOT4R(ODX,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
C
C
WRITE(IOUT,6008) XJ
IF (ONLINE) WRITE(ITOUT,6008) XJ
6008 FORMAT(/1X, ' Scaled PROFILE ,Scale Factor = ',F8.5)
CALL ODPLOT4R(PRX,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
C
C
WRITE(IOUT,6010)
IF (ONLINE) WRITE(ITOUT,6010)
6010 FORMAT(/1X,' Difference, (Pixel value - Scale*Prof)')
CALL ODPLOT4R(DIFF,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
C
C
WRITE(IOUT,6012)
IF (ONLINE) WRITE(ITOUT,6012)
6012 FORMAT(/1X,' SQRT(W*DELSQ)')
CALL ODPLOT4R(IWDEL,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
C
RETURN
END
C== PLOTRAS ==
SUBROUTINE PLOTRAS(MASK,IRAS,IBMASK,NXS,NYS)
C ===========================================
IMPLICIT NONE
C
C---- Called by subroutine *start*
C
C---- Modified by scs on 26/11/82 to display measurement box in the
C same format as used for the average spot profile. Also modified
C to enable elimination of corner pixels from measurement box
C background. If nc is zero, all pixels in the square corner
C defined by nrx and nry are flagged as omitted.
C
C
C
C
C
C .. Scalar Arguments
INTEGER NXS,NYS
C
C .. Array Arguments ..
INTEGER IRAS(5),MASK(*),IBMASK(NXS,NYS)
C ..
C .. Local Scalars ..
INTEGER I,IC,IHX,IHY,IJ,IP,IPQ,IQ,IRX,IRY,IWX,IWY,J,K,N,NBG,NMISS,
+ NPEAK,NXY,P,Q,IXMIN,IXMAX,IYMIN,IYMAX,NNBG,NBKG
REAL XSPAN,YSPAN,BGFNEW
CHARACTER IA*36
C ..
C .. Local Arrays ..
CHARACTER ISYMB(3)*1
INTEGER IB
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
SAVE
C ..
C .. Data statements ..
DATA ISYMB/'-','*',' '/
C ..
C
C
IWX = IRAS(1)
IWY = IRAS(2)
NXY = IWX*IWY
N = IWY
C
C
DO 20 J = 1,IWY
IJ = N - J + 1
C
C
DO 10 I = 1,IWX
IA(I:I) = ISYMB(MASK(IJ)+2)
IBMASK(I,J) = MASK(IJ)
IJ = IJ + IWY
10 CONTINUE
C
C
IF (ONLINE) WRITE (ITOUT,FMT=6000) (IA(K:K),K=1,IWX)
20 CONTINUE
C
C
IHX = IRAS(1)/2
IHY = IRAS(2)/2
IC = IHX + IHY - ABS(IRAS(3))
IRX = IHX - IRAS(4)
IRY = IHY - IRAS(5)
NPEAK = 0
NBG = 0
NMISS = 0
C
C
DO 40 P = -IHX,IHX
IP = ABS(P)
C
C
DO 30 Q = -IHY,IHY
IQ = ABS(Q)
IPQ = IP + IQ
C
C
IF ((IPQ.GT.IC) .OR. (IP.GT.IRX) .OR. (IQ.GT.IRY)) THEN
IF (IRAS(3).NE.0 .OR. IP.LT.IRX .OR. IQ.LT.IRY) THEN
IF (IRAS(3).GE.0 .OR. IPQ.LE.IC) THEN
NBG = NBG + 1
GO TO 30
END IF
END IF
C
C
ELSE IF ((IPQ.LT.IC) .AND. (IP.LT.IRX) .AND. (IQ.LT.IRY)) THEN
NPEAK = NPEAK + 1
GO TO 30
END IF
C
C
NMISS = NMISS + 1
30 CONTINUE
40 CONTINUE
C
C
NPEAK = NPEAK + NMISS
WRITE (IOUT,FMT=6002) NPEAK,NBG
IF (ONLINE) WRITE (ITOUT,FMT=6002) NPEAK,NBG
C
C---- Trap too few points in peak
C
IF (NPEAK.LE.2) THEN
WRITE(IOUT,FMT=6012)
IF (ONLINE) WRITE(ITOUT,FMT=6012)
6012 FORMAT(//1X,'***** ERROR *****',/,1X,'With the RASTER ',
+ 'parameters given there are two few pixels in the peak',/,1X,
+ 'Change the raster parameters (keyword RASTER) and rerun')
CALL SHUTDOWN
END IF
C
C
IF (NBG.EQ.0) THEN
NWRN = NWRN + 1
WRITE (IOUT,FMT=6004)
IF (ONLINE) WRITE (ITOUT,FMT=6004)
END IF
C
C---- Check that with current value for BGFRAC, then even if all of the
C (BGFRAC*NBG) background pixels are clustered at the "bottom" of
C the box, that they will still span at least 60% of the box height,
C so that the background slope in this direction will be reasonably
C well determined.
45 NBKG = NINT(BGFRAC*NBG)
NNBG = 0
IYMAX = 0
DO 60 J = 1,NYS
DO 50 I = 1,NXS
IF (IBMASK(I,J).EQ.-1) THEN
C
C---- Background point
C
IF (NNBG.EQ.0) IYMIN = J
NNBG = NNBG + 1
IF (NNBG.GE.NBKG) THEN
IYMAX = J
GOTO 62
END IF
END IF
50 CONTINUE
60 CONTINUE
C
62 YSPAN = REAL(IYMAX - IYMIN)/REAL(NYS-1)
IF (YSPAN.LT.0.5) THEN
IF (BGFRAC.LE.0.9) THEN
WRITE(IOUT,FMT=6006) BGFRAC,100*YSPAN,BGFRAC+0.1
IF (ONLINE) WRITE(ITOUT,FMT=6006) BGFRAC,100*YSPAN,BGFRAC+0.1
BGFRAC = BGFRAC + 0.1
GOTO 45
ELSE IF (BGFRAC.LT.1.0) THEN
BGFNEW = 1.0
WRITE(IOUT,FMT=6006) BGFRAC,100*YSPAN,BGFNEW
IF (ONLINE) WRITE(ITOUT,FMT=6006) BGFRAC,100*YSPAN,BGFNEW
BGFRAC = 1.0
GOTO 45
ELSE
WRITE(IOUT,FMT=6010)
IF (ONLINE) WRITE(ITOUT,FMT=6010)
CALL SHUTDOWN
END IF
END IF
C
C---- Now do the check in the other direction, ie checking span in X
C
65 NBKG = NINT(BGFRAC*NBG)
NNBG = 0
IXMAX = 0
DO 80 I = 1,NXS
DO 70 J = 1,NYS
IF (IBMASK(I,J).EQ.-1) THEN
C
C---- Background point
C
IF (NNBG.EQ.0) IXMIN = I
NNBG = NNBG + 1
IF (NNBG.GE.NBKG) THEN
IXMAX = I
GOTO 82
END IF
END IF
70 CONTINUE
80 CONTINUE
C
82 XSPAN = REAL(IXMAX - IXMIN)/REAL(NXS-1)
IF (XSPAN.LT.0.5) THEN
IF (BGFRAC.LE.0.9) THEN
WRITE(IOUT,FMT=6006) BGFRAC,100*XSPAN,BGFRAC+0.1
IF (ONLINE) WRITE(ITOUT,FMT=6006) BGFRAC,100*XSPAN,BGFRAC+0.1
BGFRAC = BGFRAC + 0.1
GOTO 65
ELSE IF (BGFRAC.LT.1.0) THEN
BGFNEW = 1.0
WRITE(IOUT,FMT=6006) BGFRAC,100*XSPAN,BGFNEW
IF (ONLINE) WRITE(ITOUT,FMT=6006) BGFRAC,100*XSPAN,BGFNEW
BGFRAC = 1.0
GOTO 65
ELSE
WRITE(IOUT,FMT=6010)
IF (ONLINE) WRITE(ITOUT,FMT=6010)
CALL SHUTDOWN
END IF
END IF
C
C---- Format statements
C
6000 FORMAT (10X,36 (A1,1X))
6002 FORMAT (' For this BOX there are',I5,' Points in the PEAK',/' ',
+ ' ',I5,' Points in the BACKGROUND')
6004 FORMAT (/'WARNING - There are no Points in the BACKGROUND!!')
6006 FORMAT(/,1X,'****** WARNING ******'/,1X,'****** WARNING ******',
+ /,1X,'With the current value of BGFRAC (',F3.1,'), the',
+ ' gradient in Y may not',/,1X,'be well determined, as the',
+ ' points could span only',F3.0,'% of the',/,1X,'height',
+ ' of the box. BGFRAC INCREASED TO ',F4.2)
6008 FORMAT(/,1X,'****** WARNING ******'/,1X,'****** WARNING ******',
+ /,1X,'With the current value of BGFRAC (',F3.1,'), the',
+ ' gradient in X may not',/,1X,'be well determined, as the',
+ ' points could span only',F3.0,'% of the',/,1X,'width',
+ ' of the box. BGFRAC INCREASED TO ',F4.2)
6010 FORMAT(//1X,'**** FATAL ERROR ***',/,1X,'Cannot increase BGFRAC',
+ ' above 1.0. Change box parameters')
C
C
END
C== PLOTSPOT ==
SUBROUTINE PLOTSPOT(OD,IRAS,MASK,MASKREJO)
C ========================================
C
C---- Print reflection and background subtracted reflection
C
C MASKREJO Array containing list of rejected background pixels
C because they are outliers. This is set up in EVAL
C and passed back to PROCESS.
C
C
C
IMPLICIT NONE
C
C
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
LOGICAL WEIGHT,PKONLY
C ..
C .. Array Arguments ..
INTEGER IRAS(5),MASK(MAXBOX),OD(MAXBOX),
+ MASKREJO(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,APC,B,C
INTEGER HX,HY,IJ,NX,NY,P,Q,IDR,MAXPIX
C ..
C .. Local Arrays ..
INTEGER ODX(MAXBOX),MASKREJP(NREJMAX),LMASKREJP(NREJMAX)
C ..
C .. External Subroutines ..
EXTERNAL ODPLOT4R
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C
C
SAVE
C ..
C
IDR = 1
HX = IRAS(1)/2
HY = IRAS(2)/2
A = ASPOT(9)
B = ASPOT(10)
C = ASPOT(11)
MASKREJP(1) = 0
LMASKREJP(1) = 0
IJ = 0
NX = IRAS(1)
NY = IRAS(2)
C
C
DO 20 P = -HX,HX
APC = A*P + C
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
ODX(IJ) = NINT(OD(IJ) - (APC + B*Q))
10 CONTINUE
20 CONTINUE
C
C
WRITE(IOUT,6000)
IF (ONLINE) WRITE(ITOUT,6000)
6000 FORMAT(/1X, ' Original pixel values')
MAXPIX = 0
CALL ODPLOT4R(OD,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
WRITE(IOUT,6002)
IF (ONLINE) WRITE(ITOUT,6002)
6002 FORMAT(/1X, ' Background substracted values')
CALL ODPLOT4R(ODX,NX,NY,IDR,MASK,MASKREJO,MASKREJP,LMASKREJP,
+ MAXPIX)
C
C
RETURN
END
C== POSTREFL ==
SUBROUTINE POSTREFL(IRECG,ISPOT,ISDBSI,BKGSP,RESID,RETA,
+ RDIVH,RDIVV,FIXED,ISTAT,LASTREC,NEWPREF,ISEG,MULTISEG)
C
IMPLICIT NONE
C---- Write header information and reflection list for input to
C IDXREF for postrefinement. Common block
C debug(37) THIS S/R
C
C IRECG Determines initialisation.
C If zero, arrays are initialised.
C
C If negative, then in addition to this NIMAG
C (counter for number of images for which post-refinement
C data has been stored) is set to zero. NIMAG is used
C when ADDING data from several images to enable refinement
C of cell parameters.
C
C If positive, then this is the record number (in generate file)
C of the reflection whose contribution is to be added to
C the reflection list.
C
C -999 When called by mosflm to actually carry out the
C post-refinement. If NADD>1 but NIMAG3*RMS RESID.)',/' XOBS DELX Y',
+ 'OBS DELY')
6016 FORMAT (' ',2 (2X,I6,F6.1))
6018 FORMAT (' Final RMS Residual: ',F8.1,/5X,'XCEN YCEN D1 ',
+ ' D2 PHI PSI',/1X,2I8,2X,F7.6,2X,F7.6,2F8.2)
6020 FORMAT (' Refined FIDUCIAL Constants.',/' CCX: ',I5,' CCY: ',I5)
C
C
END
C== PREAD ==
C
C
C
SUBROUTINE PREAD(IB,L,IU)
C =========================
C
C
C
C
C .. Scalar Arguments ..
INTEGER IU,L
C ..
C .. Array Arguments ..
INTEGER*2 IB(L)
C ..
C
C
READ (IU) IB
C
C
END
SUBROUTINE PREDICT(PSI,IFLAGPR)
C
C---- Generate a new reflection list when using interactive graphics.
C This routine is only called from subroutine "mxdspl".
C
C PSI Missetting angles
C IFLAGPR Input as zero, return as -1 if too many reflections generated.
C
C
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER IFLAGPR
C ..
C .. Array Arguments ..
REAL PSI(3)
C ..
C .. Local Scalars ..
REAL PHIAV,SX,SY,CX,CY,DTOR,DISTANCE,WAVELENGTH,THETA,
+ RESMX1,RESMX2,RESMX3,RESMX4,SDELPHIZ
LOGICAL PRDWARN,FIRST
INTEGER I,ICELLL,IMATL,IUMATL,IXPIX,IYPIX,L1,L2,IXP,IYP,IBUTTON
INTEGER IXW,IYW,LINELEN,NUMLIN,ICHECK,MODERK
CHARACTER LINE1*80,LINE2*80
C ..
C .. Local Arrays ..
INTEGER*2 ITEMP(1)
C ..
C .. External Subroutines
EXTERNAL REEK,SETMAT,XDLF_POPUP_NOTICE,PSITOPHI,CRESOL,
+ OVERLAP
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ASIN,ATAN,COS,SIN,TAN
C ..
C .. Common blocks ..
C include '../inc/amatch.f'
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C include '../inc/debug.f'
C include '../inc/graphics.f'
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C
DATA PRDWARN/.FALSE./,FIRST/.TRUE./
C ..
C .. Equivalences ..
C ..
SAVE
DTOR = 4.0*atan(1.0)/180.0
C
C
C---- Convert missetting angles PsiX,Y,Z PhiX,Y,Z
C
C---- Why is this done ? If SDELPHIZ is saved from the first call, but
C then PHIZ is
C changed by a large angle, this will not give the correct conversion from
C PSI to PHI. Try using DELPHI(3)
C
CAL IF (FIRST) THEN
CAL SDELPHIZ = DELPHI(3)
CAL FIRST = .FALSE.
CAL END IF
CAL PHIAV = (PHIBEG+PHIEND)*0.5 + SDELPHIZ
C
C---- Do NOT have to convert PSI to PHI as this has already been done in
C MXDSPL. If it is done again here it will give different answers,
CAL because the first call might have changed DELPHI(3) !!
C
CAL PHIAV = (PHIBEG+PHIEND)*0.5 + DELPHI(3)
C
C **************************
CAL CALL PSITOPHI(PSI,DELPHI,PHIAV)
C **************************
C
C---- Update amat and gmat if cell params changed
C
IMATL = 0
IUMATL = 1
ICELLL = 1
ICHECK = 0
C
C ************************
CALL SETMAT(IMATL,IUMATL,ICELLL,ICHECK)
C ************************
C
C
C---- Initialise RMC matrix - for the X and Y missetting angles.
C Rotation about x and then y
C RMC = PHIY . PHIX
C
SX = SIN(DELPHI(1)*DTOR)
SY = SIN(DELPHI(2)*DTOR)
CX = COS(DELPHI(1)*DTOR)
CY = COS(DELPHI(2)*DTOR)
C
RMC(1,1) = CY
RMC(1,2) = SX*SY
RMC(1,3) = CX*SY
RMC(2,1) = 0.0
RMC(2,2) = CX
RMC(2,3) = -SX
RMC(3,1) = -SY
RMC(3,2) = SX*CY
RMC(3,3) = CX*CY
C
C---- Set resolution limit to the edge of the displayed area, so
C that if working with a zoomed image it does not generate more
C than necessary
C Size of
C
C---- Set distance, wavelength, theta
C
DISTANCE = 0.01*XTOFD
WAVELENGTH = WAVE
THETA = TWOTHETA
I = 0
CALL CRESOL(I,I,DISTANCE,THETA,WAVELENGTH,RESMX1)
CALL CRESOL(I,NYDPX,DISTANCE,THETA,WAVELENGTH,RESMX2)
CALL CRESOL(NXDPX,I,DISTANCE,THETA,WAVELENGTH,RESMX3)
CALL CRESOL(NXDPX,NYDPX,DISTANCE,THETA,WAVELENGTH,RESMX4)
RESMX1 = MIN(RESMX1,RESMX2,RESMX3,RESMX4)
RESMX1 = WAVE/RESMX1
DSTPL = MIN(DSTMAX,RESMX1)
DSTPL2 = DSTPL*DSTPL
NSPOT = 0
C
C---- Calculate reflections present
C
MODERK = 1
C ****
CALL REEK(ITEMP(1),MODERK)
C ****
C
C---- Check for too many reflections predicted
C
IF (MODERK.EQ.-1) THEN
IFLAGPR = -1
RETURN
END IF
C
C---- Check for overlapping reflexions
C
C *******
CALL OVERLAP
C *******
C
C
END
c predict_spots.f
c maintained by G.Winter
c 15th May 2002
c
c This is a subroutine to implement the spot prediction function, so
c that the lists of predictions can be returned to the GUI.
c
c
c
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c
subroutine predict_spots(argc, argv, types, values)
c specification:
c
c 1. Predict where the spots should be ...
c
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/gui.f
c gui.h
c maintained by G.Winter
c 16th April 2002
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c This defines the variables and common blocks which are used by the
c new gui control routine. This will also be used in xdisp and control,
c to switch the new gui on!
c
c
logical gui_switch
integer nargs
parameter (nargs = 200)
common /gui/ gui_switch
C&&*&& end_include ../inc/gui.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
external predict, phitopsi, ccplwc, lenstr
integer argc, types(nargs), lenstr
character*80 argv(nargs)
character*1024 outline
real values(nargs), xc, yc, xcal, ycal
integer errflag, i, n_full, n_partial, n_wide, n_overlap
integer ixsize, iysize
real psi(3), phiav
integer*2 full_pos(2 * nrefls)
integer*2 partial_pos(2 * nrefls)
integer*2 wide_pos(2 * nrefls)
integer*2 overlap_pos(2 * nrefls)
phiav = 0.5 * (phibeg + phiend)
n_full = 0
n_partial = 0
n_wide = 0
n_overlap = 0
call phitopsi(delphi, psi, phiav)
call predict(psi, errflag)
ixsize = iras(1) - 2 * iras(4)
iysize = iras(2) - 2 * iras(5)
if(ixsize .eq. 0) ixsize = 5
if(iysize .eq. 0) iysize = 5
if(errflag .lt. 0) then
1 format('',
$ 'error',
$ 'Prediction failed with ', i6, '',
$ '')
outline = ' '
write(outline, fmt = 1) errflag
call write_socket_length(serverfd, lenstr(outline), outline)
return
end if
c compute the positions in sensible coordinates
do i = 1, nspot
xc = xg(i)
yc = yg(i)
call mmtopx(xcal, ycal, xc, yc)
ix(i) = nint(xcal * fact)
iy(i) = nint(ycal * fact)
end do
do i = 1, nspot
if (irg(i) .gt. 20) then
n_partial = n_partial + 1
partial_pos(2 * n_partial - 1) = iy(i)
partial_pos(2 * n_partial) = ix(i)
else if(irg(i) .eq. 0) then
n_full = n_full + 1
full_pos(2 * n_full - 1) = iy(i)
full_pos(2 * n_full) = ix(i)
else if(irg(i) .eq. 2) then
n_overlap = n_overlap + 1
overlap_pos(2 * n_overlap - 1) = iy(i)
overlap_pos(2 * n_overlap) = ix(i)
else if(irg(i) .eq. 3) then
n_wide = n_wide + 1
wide_pos(2 * n_wide - 1) = iy(i)
wide_pos(2 * n_wide) = ix(i)
end if
end do
if(.not. socklo) then
write(*, *) 'Predicted'
write(*, *) n_full, ' fulls'
write(*, *) n_partial, ' partials'
write(*, *) n_wide, ' wides'
write(*, *) n_overlap, ' overlaps'
else
call write_full(n_full, serverfd, full_pos)
call write_partial(n_partial, serverfd, partial_pos)
call write_overlap(n_overlap, serverfd, overlap_pos)
call write_wide(n_wide, serverfd, wide_pos)
write(*, *) 'Predicted'
write(*, *) n_full, ' fulls'
write(*, *) n_partial, ' partials'
write(*, *) n_wide, ' wides'
write(*, *) n_overlap, ' overlaps'
2 format('',
$ 'ok',
$ '', i4,
$ '', i4, '',
$ '')
outline = ' '
write(outline, fmt = 2) ixsize, iysize
call write_socket_length(serverfd, lenstr(outline), outline)
end if
return
end
C== PRINTSTATS ==
C
SUBROUTINE PRINTSTATS(IPACK)
C ============================
C
IMPLICIT NONE
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C---- This routine loops though the reflections for the current
C pack and produces some statistics
C
C JR(I) = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot
C = 3 Cut off at both ends
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C
C ISTATS(IPACK,1) Totaol number
C ISTATS(IPACK,2) Number of fulls
C ISTATS(IPACK,1) Number of overlaps
C
C .. Scalar Arguments ..
INTEGER IPACK
C ..
C .. Local Scalars ..
INTEGER I,IM,NPARTL,NOVERL,IR,NOUTSIDE,IR1,IR2
C ..
C .. Local Arrays ..
INTEGER ICOUNT(10)
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
SAVE
C
NFULL = 0
NOUTSIDE = 0
NPARTL = 0
NOVERL = 0
IR1 = 2*IPAD + 1
C
C
DO 20 I = 1,NSPOT
C
IR = IRG(I)
IM = IMG(I)
C
C
C IREASON = 0 Full spot
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot within cusp (set in subroutine REEK)
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C = 2 Extends over too many images
C
C
IF ((IR.EQ.1).OR.(IR.EQ.4).OR.(IR.EQ.10))
+ NOUTSIDE = NOUTSIDE + 1
IF ((IM.EQ.0).AND.(IR.EQ.0)) NFULL = NFULL + 1
IF (IR.GE.IR1) NPARTL = NPARTL + 1
IF (IR.EQ.2) NOVERL = NOVERL + 1
20 CONTINUE
C
C---- NOUTGEN - number of spots output to 'generate' file
C Omit those that fail Dstar and X,Y,R tests
C
ISTATS(IPACK,1) = NSPOT - NOUTSIDE
ISTATS(IPACK,2) = NFULL
ISTATS(IPACK,3) = NOVERL
END
C== PRINTTEST ==
SUBROUTINE PRINTTEST(ANGLE)
C ===========================
C
C
IMPLICIT NONE
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- Prints the results of the Testgen option for one
C oscillation angle if plot specified, write an input
C file for Curvy to plot results on Benson.
C
C
C .. Scalar Arguments ..
REAL ANGLE
C ..
C .. Local Scalars ..
REAL XANGLE
INTEGER I,J,JANGLE,N1,N2,NACROSS,NBITS,NOVER,NPRINT,IPLOT
CHARACTER CHAR*10
C ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
SAVE
C .. Data statements ..
DATA JANGLE/0/,CHAR/'OX+*=OX+*='/
C ..
C
C
C---- JANGLE selects character for plotting (if requested)
C
JANGLE = JANGLE + 1
C
WRITE (IOUT,FMT=6000) ANGLE
IF (ONLINE) WRITE (ITOUT,FMT=6000) ANGLE
C
WRITE (IOUT,FMT=6002)
IF (ONLINE) WRITE (ITOUT,FMT=6002)
C
DO 20 J = 1,NPACK
WRITE (IOUT,FMT=6004) IDPACK(J),PHIBEGA(J),
+ PHIENDA(J),ISTATS(J,1),ISTATS(J,2),ISTATS(J,3)
IF (ONLINE) WRITE (ITOUT,FMT=6004) IDPACK(J),PHIBEGA(J),
+ PHIENDA(J),ISTATS(J,1),ISTATS(J,2),ISTATS(J,3)
20 CONTINUE
C
C
C---- Write a file to plot results on Benson
C
IPLOT = 0
IF (IPLOT.NE.0) THEN
C
C---- Write legend
C
WRITE (4,FMT=6008) ANGLE,CHAR(JANGLE:JANGLE)
C
C---- Write out mean oscillation angle and number of overlaps
C limit max number of overlaps to 250
C
DO 30 I = 1,NPACK
NOVER = ISTATS(I,3)
IF (NOVER.GT.250) NOVER = 250
XANGLE = (PHIBEGA(I)+PHIENDA(I))*0.5
WRITE (4,FMT=6010) XANGLE,NOVER
30 CONTINUE
C
C
END IF
C
C---- Format statements
C
6000 FORMAT (//1X,'OSCILLATION ANGLE',F5.2,/1X,
+ '======================')
6002 FORMAT (//5X,'Pack',10X,'Osc range',8X,'Total',8X,'Fulls',7X,
+ 'Overlaps')
6004 FORMAT (4X,I5,6X,F6.2,' - ',F6.2,6X,I5,7X,I5,9X,I5)
6006 FORMAT (/1X,30 ('='))
6008 FORMAT ('LANGLE=',F4.2,'!',A)
6010 FORMAT (F10.2,I5)
C
C
END
C
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== PROCESS ==
SUBROUTINE PROCESS(NFLMO,IXSHIFT,IYSHIFT,ADDPART,ISKIPI,
+ PLRESID,NEWPREF,LPINTG,NOBACK)
C ======================================================================
IMPLICIT NONE
C
C============== NEW PROFILE FITTING, MASSIVE CHANGES ==========
C
C Last modified 16/3/90 to fix bug when no reflections found in a
C given profile box
C
C---- This subroutine reads the shoeboxes written by MEAS, forms the
C standard profiles and calculates profile fitted and summation
C integration intensities, monitors for "badspots" and stores
C intensities and standard deviations to be written back to
C generate file.
C
C
C
C****** DEBUG(18) FOR THIS SUBROUTINE ******
C
C---- Next arrays for calculating contribution of instrumention
C errors to intensity sigmas
C IPNTR(NREFLS)
C INTEGER*2 NPEAK(NREFLS),IRMSBG(NREFLS),IBGND(NREFLS)
C
C
C---- Array to save averaged profiles during averaging
C assumes no more than half the total number (nmasks) of
C profiles will need to be averaged
C INTEGER*2 IPRSAVE(MAXBOX,NMASKS)
C
C Elements of SUMPQ
C p,q are pixel coords wrt centre of box
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C Elements of PQSUMS
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY.
C
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM = 200)
C ..
C .. Scalar Arguments ..
INTEGER NFLMO,IXSHIFT,IYSHIFT
LOGICAL ADDPART,PLRESID,NEWPREF,LPINTG,NOBACK
C ..
C .. Array Arguments ..
INTEGER ISKIPI(MAXPAX)
C ..
C .. Local Scalars ..
REAL A,AX,ASUM,B,BX,BASE,BGDEVMAX,BGMAX,BGND,BGRATIO,BGREXP,BGRMS
+ ,BOXFAC,BSUM,C,CX,CFAC,DELEPS,DELI,DELSIG,DELX,DELY,ERRINST,
+ GRADM,ODMIN,PEAKVAR,PI,PKIRATIO,PKRATIOS,PRFACT,
+ R,RANGE,RMSBG,SCAI,SCAL,SCALE,SIGMAP,FRAC,PRFRAC,
+ SIGMAPSQ,SOD,SODBG,SODPRO,SPOD,SQOD,TBGND,TPEAK,TRUOD,VBG,
+ VSPOT,WGT,WPX,WPY,X,XR,XX,YR,YY,PKREJS,VARTOT,BGRFRC,XC,YC,
+ XCG,YCG,XCGCEN,YCGCEN,XCGRMS,YCGRMS,XWCGRMS,YWCGRMS,WTCEN,
+ WTPRK,WTPRSUM,GMEAN,GRMS,XWIDTH,YWIDTH,LOWPKFR,SUMREJ,SUMBG,
+ ABSSOD,DBIN1,DBIN2,RAT1,RAT2,DSTSQ,DSPOT,X1,X2,PSCALE
INTEGER I,I1BOX,I2BOX,ICENBOX,IDR,IFBOX,IFLG,IFREC,II,IPART,
+ ILBOX,IMAP,IND,INEIGH,IOD,IP,IPASS,IPLOUT,IPNT,IPRUNIT,
+ IRECG,IS,ISDBSI,ISIGPRO,ISPOT,ISPOTPRO,ISTRIP,IXPIX,
+ IXCUR,IXN,IXVEE,IXX,IWTBOX,IYPIX,IYCUR,IYN,IXP,
+ IYVEE,IYY,J,JBGND,JBOX,JDO,JKBOX,K,KREC,L,LEN,M,
+ MASKIJ,MAXMAXR,MAXOD,MINOD,MODE,MODEWR,N,NACFILM,NBOXAV,
+ NBREJ,NECX,NECY,NGO,NMINTR,NNOBOX,NNREJ,NOVR,
+ NOVRSP,NOVRTOT,NP,NPBOX,NPK,NPRFILM,NPROFS,NRBX,NREJ,
+ NREXP,NRF,NRFP,NRFTOT,NRSPOTS,NSBOX,
+ NTOTBOX,NWKSP,NWKTOT,NXB,NXX,NXY,NXYB,NY,
+ NYB,NYY,IFAIL,JDUMP,KSTART,KEND,
+ NSUMR,IA,IB,IC,NOFFEDG,NXYH,NOREAD,IOVER,INPRF,NCH,
+ NCH4,IOUTPRF,NBADBG,ITHBIN,ISTRIPCUR,NFBOX,ICENSTRIP,
+ ICENY,NRFL,NNEIGHB,NREFSAVE,LNPARTEND,MASKMODE,NLOWPK,
+ ISUMPART,ISUMOVER,IBAD,IR,IM,NREJSUM,MAXPIX,NBADPK,IPMAX,
+ NBIN1,NBIN2,IXM,IYM,LINELEN,NUMLIN,ITOG,IPPINTG,IVHPAR,
+ IERR,IHX,IHY,IXRIM,IYRIM
LOGICAL FINISH,FULL,LDUMP,VALONGY,YES,ERRSET,OVRLFIT,
+ EDGEFIT,FIRSTBOX,CENTRAL,PWARN1,GRADBAD,LBADBG,
+ FIRSTBLOCK,XDEBUG,RECOVERED,FIRSTSP,KDUMP,MDUMP,
+ BADSPOT,BADPROF
CHARACTER PASS*10,PRFILE*80,LPROFN*100,PROFFN*100,STR*3,
+ BADSTR(17)*37,STR1*1,LINE*80,LINE2*80,VALUESTR*80
C ..
C .. Local Arrays ..
REAL PQSUMINV(9,NMASKS),PQSUMS(6,NMASKS),PROFACT(NMASKS),
+ PROFSUMS(4,NMASKS+1),RMSBGA(NMASKS),RMSBGBOX(NMASKS),
+ GRADA(NMASKS),GRADASQ(NMASKS),GRADB(NMASKS),GRADBSQ(NMASKS),
+ SAVERMS(NMASKS),SAVESCAL(NMASKS,2),SUMPQ(6,1:NNLINE-1),
+ WTPR(9),XSH(16),YSH(16),
+ RMSBGX(NREFLS),BGNDX(NREFLS),XCGSTRIP(1:NNLINE-1),
+ YCGSTRIP(1:NNLINE-1),WTSTRIP(1:NNLINE-1),
+ XCGBOX(NMASKS),YCGBOX(NMASKS),WTBOX(NMASKS),
+ XCGSP(NMASKS),YCGSP(NMASKS),XWCGSP(NMASKS),YWCGSP(NMASKS),
+ WCGSP(NMASKS),CBOX(NMASKS),CBOXAV(NMASKS),
+ WPROFSUMS(4,NMASKS+1),SUMPQW(6),PQSUMSW(6),
+ PQSUMSPOT(6),PQSUMINVSPOT(9),TOLBOX(NMASKS),PRGRAD(NMASKS)
INTEGER IH(7),ILIM(4),INDEX(9),
+ IPNTR(NREFLS),IPRNUM(9),
+ LISTPIX(9,1:NNLINE-1),LRAS(5),MASKREJP(NREJMAX,NMASKS),
+ MASK(MAXBOX,1:NNLINE-1),MASKREJ(NREJMAX,NMASKS),
+ MAXODBOX(NMASKS),MINODBOX(NMASKS),
+ NEIGHBOUR(9,NMASKS),NDSCR(1:NNLINE-1),
+ NOVRL(NMASKS),NOVRLSAVE(NMASKS),NOVRS(1:NNLINE-1),
+ NRBOX(1:NNLINE-1),NRFSAVE(NMASKS),NSH(16),
+ NWK(NMASKS),NWKS(1:NNLINE-1),NWKSAVE(NMASKS),
+ OD(MAXBOX),TABLE(0:255),IABC(NREFLS),NCGSP(NMASKS),
+ IPRSAVE(MAXBOX,NMASKS),IOPTRAS(3,NMASKS),
+ IWPROFL(MAXBOX),MASKW(MAXBOX),MASKREJW(NREJMAX),
+ NRFBOXW(NMASKS),LMASKREJ(NREJMAX),LMASK(MAXBOX),
+ MASKREJAV(NREJMAX,NMASKS),MASKREJO(NREJMAX),
+ LMASKREJP(NREJMAX),NDEBUGS(80)
INTEGER*2 IBUF(12),NPEAK(NREFLS)
LOGICAL AVERAGE(NMASKS),NOPROFILE(NMASKS),SDEBUG(80)
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL BGREJECT,CBYTE2,COMPR,CORRELATE,GETHKL,
+ GETPROF,INTEG2,MEANPRO,PIXLIST,
+ PLOTPROF,PREAD,PROFREAD,PROFWRITE,PWRGEN,QUICKINT,
+ RASPLOT,RASPLOT4,RASTOMM,REPORT,SCALEPROF,
+ SETMASK,SETSUMS,STATS,STDPROF,TOPHAT,VARPROF,
+ WRGEN,XYSHIFT,YESNO,CCPLWC,MPAUSE,GETSTRIP,GETYIND,
+ GETBOX,WTPROF,WPRSETUP,PRUPDATE,MASKIT,MASKONE,INTEG3,
+ SKIPIMG,CCPOPN,GETCENT,GETBIN,WARNINGS,MMTOPX,ODPLOT4,
+ WRMTZ,SHUTDOWN,DISCR,RECUNPACK,GETREJ,GETMOREBG,
+ XDLF_FLUSH_EVENTS,MXDCIO,MXDWIO,MXDRIO,MPARSE,
+ PROFGRAD
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,AMAX0,ATAN,COS,MAX,MIN,MOD,SIGN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/parm2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm2.h
C---- START of include file parm2.h
C
C
C .. Scalars in common block /PARM2/ ..
REAL PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2
LOGICAL PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,PUPDATE,PKONLY,DENSE,PRFULLS,
+ DECONV
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
INTEGER IHD
C ..
C .. Common Block /PARM2/ ..
COMMON /PARM2/PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,
$ PKWDLIM3,PKWDOUTL,
$ ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2,
$ IHD(3,50),
$ PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,
+ PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,
+ PUPDATE,PKONLY,DENSE,
+ PRFULLS,DECONV
C ..
C
C
C&&*&& end_include ../inc/parm2.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/praccum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file praccum.h
C---- START of include file praccum.h
C
C
C ..
C .. Arrays in common block /PRACCUM/ ..
REAL PRDATA
C
C .. Scalars in common block /PRACCUM/ ..
LOGICAL ACCUMULATE,FIRSTPASS,SECONDPASS,THIRDPASS,FIRSTFILM,
+ NOTREAD
C ..
C .. Common Block /PRACCUM/ ..
COMMON /PRACCUM/PRDATA(4,50),ACCUMULATE,FIRSTPASS,SECONDPASS,
+ THIRDPASS,FIRSTFILM,NOTREAD
C ..
C
C
C&&*&& end_include ../inc/praccum.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C&&*&& include ../inc/spvect.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spvect.h
C---- START of include file spvect.h
C
C
C .. Scalars in common block /SPVECT/ ..
INTEGER NRESID,IDVECT
C
C
C .. Arrays in Common Block /SPVECT/ ..
INTEGER IXSBOX,IYSBOX,IXFBOX,IYFBOX
INTEGER*2 ITXVECT
C ..
C .. Common Block /SPVECT/ ..
COMMON /SPVECT/ IXSBOX(4*NREFLS),IYSBOX(4*NREFLS),
+ IXFBOX(4*NREFLS),IYFBOX(4*NREFLS),
+ NRESID,IDVECT,ITXVECT(NREFLS*5)
C ..
C
C
C&&*&& end_include ../inc/spvect.f
C
C Extra common blocks
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
COMMON /XYSCAN/ IXPIX,IYPIX
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(1),SOD), (ASPOT(2),BGND), (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(4),DELX), (ASPOT(5),DELY), (ASPOT(6),SPOD)
EQUIVALENCE (ASPOT(7),SQOD), (ASPOT(8),SODBG), (ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C), (ASPOT(12),BGDEVMAX)
EQUIVALENCE (ASPOT(13),SODPRO), (ASPOT(14),PEAKVAR)
EQUIVALENCE (IDUM(1),MASK(1,1))
EQUIVALENCE (LRAS(1),NXX), (LRAS(2),NYY)
C ..
SAVE
C .. Data statements ..
DATA INDEX/6,4,7,2,1,3,8,5,9/
DATA INPRF/0/,IOUTPRF/0/,FIRSTBLOCK/.TRUE./
DATA BADSTR/'Poor fit to background plane',
+ 'Poor profile fit',
+ 'Poor background plane and profile fit',
+ 'Intensity too negative',
+ 'Poor background plane,I too negative',
+ 'Poor profile fit and I too negative',
+ 'Poor bk plane and prof fit, I too -ve',
+ 'Background plane gradient too steep',
+ 'Poor bk plane fit, gradient too steep',
+ 'Poor profile fit, gradient too steep',
+ 'Bkg plane, profile fit and gradient',
+ 'I too -ve and gradient too steep',
+ 'I too -ve, bk plane, gradient',
+ 'I too -ve,bk and profile fit,gradient',
+ 'Everything !!',
+ 'Spot flagged for dumping',
+ 'Less than 10 background pixels left'/
C
C
MAXPIX = 0
XDEBUG = .FALSE.
C
C----- Number of bins for resolution analysis (don't change, formats will not
C be correct
C NBIN2 is number of resolution bins when checking to see if data should
C not be written to MTZ file (RESOLUTION CUTOFF keywords)
C
NBIN1 = 8
NBIN2 = 30
C
IF (FIRSTFILM) THEN
XWIDTH = 0.0
YWIDTH = 0.0
C
C---- IDR indicates direction of scanning, +1 for left to right
C
IDR = 1
C
C---- NOREAD keeps track of the number of "images" read from SPOTOD.
C When using postrefinement, if the shift in orientation is large
C so that the image is remeasured, then the measurement boxes will
C be written out twice, and the first should be skipped. Array ISKIPI
C (set in MAIN) keeps track of skipping required.
C
NOREAD = 0
C
IF (.NOT.IMGP) THEN
C
C---- Generate look-up table for corrected ods and sigmas
C
CFAC = CURV/N1OD
BASE = BASEOD*N1OD
C
C
DO 10 I = 0,255
TRUOD = I - BASE
TABLE(I) = (CFAC*TRUOD+1.0)*TRUOD + 0.5
TABLE(I) = AMAX0(0,TABLE(I))
10 CONTINUE
C
END IF
C
C---- Determine scale factor for intensities
C
C **********************************
CALL SETMASK(MASK(1,1),IRAS)
CALL SETSUMS(MASK(1,1),IRAS,SUMPQ(1,1))
C **********************************
C
SCAI = 2.0*FLOAT(ISCAL)/SUMPQ(5,1)
C
C---- IOVER is flag for overloaded reflections, 9999 for film,
C 999999 for IP.
C
IOVER = 9999
C
C---- For IP, make scale factor 1.0 for Mar scanners and 1.0/GAIN for others
C
C
C ***** machine specific code follows *****
C
IF (IMGP) THEN
IOVER = 999999
IF (MACHINE.EQ.'MAR ') THEN
SCAI = 1.0
ELSE
SCAI = 1.0/GAIN
END IF
C
IRANGE(1) = -750
IRANGE(2) = 0
DO 11 I = 3,9
IRANGE(I) = 1250*2**(I-3)
11 CONTINUE
END IF
C
C---- Set up resolution bins
C
IRECG = 0
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
C
C---- END of IF FIRSTFILM block
C
END IF
C
C
PI = ATAN(1.0)*4.0
NLOWPK = 0
NRESID = 0
C
C---- Initialise AVERAGE here so that it is not reset when returning
C to reform standard profiles for the first block of images after
C determining the optimised rsater parameters
DO 12 M = 1,NMASKS
AVERAGE(M) = .FALSE.
12 CONTINUE
C
C---- Read XCEN etc from MOSFLM.OUT. First check if this "image" should
C be skipped (only occures when films are measured twice as a result
C of a large shift in postrefinement)
C
14 NOREAD = NOREAD + 1
IF (ISKIPI(NOREAD).NE.0) THEN
IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6001) NOREAD
IF (ONLINE) WRITE(ITOUT,FMT=6001) NOREAD
6001 FORMAT(1X,'Skipping image number',I3)
END IF
CALL SKIPIMG(INMO)
GOTO 14
END IF
C
READ (INMO) XCEN,YCEN,NREF,MAXR,LNPARTEND
C
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) MAXR,XCEN,YCEN,NREF
6000 FORMAT (//1X,'Start PROCESS, MAXR,XCEN,YCEN,NREF',I6,2F7.1,I6)
WRITE (IOUT,FMT=6000) MAXR,XCEN,YCEN,NREF
END IF
C
C
IF (ONLINE) THEN
IF (FIRSTFILM) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6002)
IF (BRIEF) WRITE (IBRIEF,FMT=6002)
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6005)
IF (BRIEF) WRITE (IBRIEF,FMT=6005)
END IF
END IF
6002 FORMAT(1X,'Forming standard profiles and integrating first',
+ ' image')
6005 FORMAT(1X,'Integrating spots by profile fitting')
6160 FORMAT(1X,'Residual vector plot follows')
C
C---- If profile plotting requested, open output file
C
IPLOUT = 12
IFAIL = 1
IF (IPLOT.GT.0)
C
C *********************************************
+ CALL CCPOPN(-IPLOUT,'prplot.dat',1,2,80,IFAIL)
C *********************************************
C---- Direct beam coordinates in pixels
C
NECX = XCEN*FACT + 0.5
NECY = YCEN*FACT + 0.5
C
C
IF (SECONDPASS) THEN
PASS = 'SECONDPASS'
ELSE
PASS = 'THIRDPASS'
END IF
C
K = 0
C
C
DO 30 M = 1,NMASKS
CBOX(M) = 0.0
CBOXAV(M) = 0.0
DO 20 L = 1,2
AVINTI2(M,L) = 0.0
AVPRI2(M,L) = 0.0
RMSDELI2(M,L) = 0.0
ABSDELI2(M,L) = 0.0
NRFLS2(M,L) = 0
MEANDELI2(M,L) = 0
AVSIG2(M,L) = 0.0
AVPRSIG2(M,L) = 0.0
AVDELSIG2(M,L) = 0.0
IF (M.GT.10) GO TO 20
AVINTI1(M,L) = 0.0
AVPRI1(M,L) = 0.0
RMSDELI1(M,L) = 0.0
ABSDELI1(M,L) = 0.0
NRFLS1(M,L) = 0
MEANDELI1(M,L) = 0
AVSIG1(M,L) = 0.0
AVPRSIG1(M,L) = 0.0
AVDELSIG1(M,L) = 0.0
20 CONTINUE
30 CONTINUE
C
C
DO 40 M = 1,32
NBGRHIST(M) = 0
40 CONTINUE
C
C---- Clear for statistics
C
NSPOVL = 0
NBREJ = 0
NBADBG = 0
LBADBG = .FALSE.
NOLO = 0
NEDGE = 0
NEDGE1 = 0
NBOX = 0
NBZERO = 0
NOFR = 0
NNOBOX = 0
MAXBSI = 0
MINBSI = 200
C
C
DO 50 I = 1,10
IANAL(I) = 0
IANALF(I) = 0
PKRATIO(I) = 0.0
AVSD(I) = 0.0
AVSDP(I) = 0.0
RATIO(I) = 0.0
50 CONTINUE
C
DO 52 I = 1,9
NRESPF(I) = 0
NRESPP(I) = 0
NRESSF(I) = 0
NRESSP(I) = 0
FIOVSDP(I) = 0.0
FIOVSDS(I) = 0.0
PIOVSDP(I) = 0.0
PIOVSDS(I) = 0.0
IRESPF(I) = 0
IRESPP(I) = 0
IRESSF(I) = 0
IRESSP(I) = 0
ISDRESPF(I) = 0
ISDRESPP(I) = 0
ISDRESSF(I) = 0
ISDRESSP(I) = 0
52 CONTINUE
C
C
DO 60 I = 1,16
XSH(I) = 0.0
YSH(I) = 0.0
NSH(I) = 0
IF (I.GT.13) GO TO 60
IVSM(I) = 0
RSIGVSM(I) = 0
NIVSM(I) = 0
60 CONTINUE
C
C---- Set corner cutoff and X and Y rim parameters. These are the same for
C all measurement boxes (prior to optimisation).
C
DO 70 I = 3,5
LRAS(I) = IRAS(I)
70 CONTINUE
C
C---- If keyword set, read measurement box look-up array ibox
C and profiles from logical file profile
C
IF ((PRREAD) .AND. FIRSTFILM .AND. NOTREAD) THEN
NOTREAD = .FALSE.
SCALE = 1.0
ODMIN = 0.0
CALL PROFREAD(MASKREJ,PQSUMS,PQSUMINV,PROFSUMS,WPROFSUMS,XCGBOX,
+ YCGBOX,XCGCEN,YCGCEN,ICENBOX,CENTRAL,IOPTRAS,
+ PROFACT)
C
C---- If using variable profiles, set up the quadrilaterals used to
C define which profiles are to be used in forming the average
C profile.
IF (VARPRO) THEN
MODE = 0
XR = 0.0
YR = 0.0
CALL VARPROF(MODE,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,
+ CENTRAL,XR,YR,NUMBOX,IPRNUM,WTPR)
MODE = 1
END IF
C
C---- Skip profile formation
C
GO TO 630
END IF
C
C---- If secondpass, but not firstfilm, need to assign xcen etc
C
IF (SECONDPASS .AND. (.NOT.FIRSTFILM)) THEN
NPRFILM = NPRFILM + 1
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6012) PASS,NPRFILM,XCEN,YCEN,NREF,MAXR
6012 FORMAT (1X,'Accumulate now in ',A,' on image number',I3,/2X,
+ 'XCEN=',F7.1,' YCEN=',F7.1,' NREF=',I5,' MAXR=',I5)
IF (ONLINE) WRITE (ITOUT,FMT=6012) PASS,NPRFILM,XCEN,YCEN,
+ NREF,MAXR
END IF
END IF
C
C---- Skip profile formation if accumulating profiles and this is
C the second pass but not the firstfilm or if it is the
C third pass
C
IF (ACCUMULATE .AND. ((SECONDPASS.AND. (.NOT.FIRSTFILM)).OR.
+ (THIRDPASS))) GO TO 630
C
C---- Ditto for b and c films or if profiles have been read in
C
IF (BFILM .OR. CFILM .OR. PRREAD) GO TO 630
C
C
DO 170 M = 1,NMASKS
MAXODBOX(M) = 0
MINODBOX(M) = 0
NOPROFILE(M) = .FALSE.
GRADA(M) = 0.0
GRADASQ(M) = 0.0
GRADB(M) = 0.0
GRADBSQ(M) = 0.0
NRFBOX(M) = 0
NRFBOXW(M) = 0
NOVRL(M) = 0
NWK(M) = 0
RMSBGBOX(M) = 0.0
XCGBOX(M) = 0.0
YCGBOX(M) = 0.0
WTBOX(M) = 0.0
NCGSP(M) = 0
XCGSP(M) = 0.0
YCGSP(M) = 0.0
XWCGSP(M) = 0.0
YWCGSP(M) = 0.0
WCGSP(M) = 0.0
C
DO 150 L = 1,9
NEIGHBOUR(L,M) = 0
150 CONTINUE
C
C
DO 160 L = 1,MAXBOX
IPROFL(L,M) = 0
WPROFL(L,M) = 0.0
WPRSUMS(L,M) = 0.0
160 CONTINUE
C
C
170 CONTINUE
C
C
XCGCEN = 0.0
YCGCEN = 0.0
WTCEN = 0.0
NPBOX = 0
IXCUR = 0
IYCUR = 0
C
C---- NACFILM counts number of films included so far in the average spot
C profiles in accumulate mode
C
NACFILM = 0
MAXMAXR = 0
C
C---- NPRFILM counts number of a films fully processed in accumulate
C mode
C
NPRFILM = 1
FINISH = .FALSE.
PWARN1 = .FALSE.
C
C
IF (MAXR.LE.MAXBOX) GO TO 210
NWRN = NWRN + 1
WRITE (IOUT,FMT=6014) MAXR,MAXBOX
6014 FORMAT (/,1x,'***** FATAL ERROR *****',/,1X,
+ 'Measurement box has',I5,' pixels but the maximum',
+ ' allowed is',I5,/,1X,'If the spots really are that big',
+ ' change parameter MAXBOX with a global edit')
IF (ONLINE) WRITE (ITOUT,FMT=6014) MAXR,MAXBOX
IF (BRIEF) WRITE (IBRIEF,FMT=6014) MAXR,MAXBOX
CALL SHUTDOWN
C
C
C
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C---- NEW PROFILE FITTING
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C
C---- Determine average fully recorded spot for each area on the
C detector.
C
C If accumulating profiles from several films, retrieve
C xcen etc for this film
C
210 NACFILM = NACFILM + 1
C
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
IF (ACCUMULATE) THEN
FINISH = .FALSE.
C
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6018) PASS,NACFILM,XCEN,YCEN,NREF,MAXR
6018 FORMAT (1X,'Accumulate now in ',A,
+ ' adding in ODS for image number',I3,/2X,'XCEN=',F7.1,
+ ' YCEN=',F7.1,' NREF=',I5,' MAXR=',I5,' MAXMAXR=',I5)
IF (ONLINE) WRITE (ITOUT,FMT=6018) PASS,NACFILM,XCEN,YCEN,
+ NREF,MAXR
END IF
END IF
C
C
NECX = XCEN*FACT + 0.5
NECY = YCEN*FACT + 0.5
C
C
C---- Get box number for central (ie around direct beam) box
C
CALL GETCENT(NECX,NECY,ICENBOX,CENTRAL)
C
C---- Get strip number and Y index for central box
C
CALL GETSTRIP(ICENBOX,ICENSTRIP)
CALL GETYIND(ICENBOX,ICENY)
C
C---- Now set up the TOLerance for each box. The tolerance varies
C between TOLMIN and TOLMAX dependent on the proximity to the
C central box.
C
IPMAX = 0
DO 212 JBOX = 1,NUMBOX
IF (.NOT.BOX(JBOX)) GOTO 212
CALL GETSTRIP(JBOX,ISTRIP)
CALL GETYIND(JBOX,NY)
I = ABS(ISTRIP - ICENSTRIP)
J = ABS(NY - ICENY)
IP = I + J
IPMAX = MAX(IPMAX,IP)
212 CONTINUE
DO 214 JBOX = 1,NUMBOX
IF (.NOT.BOX(JBOX)) GOTO 214
CALL GETSTRIP(JBOX,ISTRIP)
CALL GETYIND(JBOX,NY)
I = ABS(ISTRIP - ICENSTRIP)
J = ABS(NY - ICENY)
IP = I + J
XX = REAL(IP)/REAL(IPMAX)
TOLBOX(JBOX) = TOLMIN + XX*(TOL - TOLMIN)
214 CONTINUE
C
C---- Set up masks allowing for spot overlap. This returns rejected
C background pixels in MASKREJ and modified background sums in
C PQSUMS and PQSUMINV for each mask.
C Note that MASKIT calls GENSORT which will update NREF so
C save the correct value.
C For the very first block of images, initially we have no
C optimised raster parameters to give the spot sizes on different
C areas of the detector, so must use the raster box parameters
C determined by RMAXR. Use these to form profiles, then return
C and redetermine the profiles using the optimised raster box parameters
C in MASKIT (if PUPDATE is TRUE).
C
C If using the DENSE option, then the spot overlap is determined
C for every spot individually (MASKONE), so we do not need to call
C MASKIT here.
C
IF (.NOT.DENSE) THEN
MASKMODE = 1
IF (PUPDATE) THEN
IF (FIRSTBLOCK) THEN
MASKMODE = 1
ELSE
MASKMODE = 2
END IF
END IF
NREFSAVE = NREF
CALL MASKIT(MASKMODE,MASK(1,1),IOPTRAS(1,1),AVERAGE(1),
+ MASKREJ(1,1),MASKREJP(1,1),PQSUMS(1,1),PQSUMINV(1,1))
NREF = NREFSAVE
END IF
C
C
ISTRIPCUR = 0
C ********************************************************************
C ********************************************************************
C---- Loop over all reflections to form average profiles in each box
C ********************************************************************
C ********************************************************************
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6020) NREF,NUMBOX,PRCUTOFF
6020 FORMAT (/1X,'Reading',I5,' Reflections from mosflm.out',/1X,'NBO',
+ 'XES Currently=',I3,' PRCUTOFF=',I5)
IF (ONLINE) WRITE (ITOUT,FMT=6020) NREF,NUMBOX,PRCUTOFF
END IF
C
C---- Counter for dumped reflections
C
JDUMP = 0
C
C---- FIRSTSP is true for the first reflection on each image to be used
C in forming the standard profiles, FALSE for all others (used by MASKONE)
C
FIRSTSP = .TRUE.
C
DO 352 I = 1,NREF
IF (MOD(I,250).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
READ (INMO) LEN,IBUF
C
C ************************
CALL PREAD(BOXOD(1),LEN,INMO)
C ************************
C
CALL RECUNPACK(IBUF(1),KREC)
C
C---- Test for dumpspot
C
IF (DUMPSPOT) THEN
C
C---- Compare indices with list in IHD, set LDUMP true if match found
C and turn on DEBUG in all subroutines
C **************************
CALL COMPR(KREC,IHD,LDUMP,NHKLD)
C **************************
C
IF (LDUMP) WRITE(6,*)'Reflection found'
C---- Uncomment next two lines if full debug is wanted when forming
C the profile as well as integrating reflections
CAL IF (DUMPALL.AND.(I.GE.NDSTART).AND.((I-NDSTART).LE.NDTOT))
CAL + LDUMP = .TRUE.
IF (LDUMP) THEN
DO 351 K=1,80
SDEBUG(K) = DEBUG(K)
NDEBUGS(K) = NDEBUG(K)
DEBUG(K) = .TRUE.
NDEBUG(K) = NDTOT
351 CONTINUE
XDEBUG = .TRUE.
END IF
END IF
IXPIX = IBUF(3)
IYPIX = IBUF(4)
NXX = IBUF(5)
NYY = IBUF(6)
NPBOX = IBUF(7)
C
C---- Flag for summed partial, =1 for summed partial, else 0
C =2 for "summed" partial when other half
C was not available !
C
ISUMPART = IBUF(8)
C
C A flag for overloaded summed partials ONLY
C = 0 If not an overload
C = 1 if overloaded for integration only
C = 2 if overload for profile fitting only
C = 3 if overload for integration and profile fitting
C
ISUMOVER = IBUF(9)
C
CALL GETSTRIP(NPBOX,ISTRIP)
C
C
IF (DUMP(1) .AND. (I/NDUMP)*NDUMP.EQ.I .AND.
+ JDUMP.LE.MXDUMP) THEN
WRITE (IOUT,FMT=6022) I,NXX,NYY,IXPIX,IYPIX,KREC,NPBOX,ISTRIP
6022 FORMAT (1X,'From mosflm.out, reflection',I5,' NXX=',I3,' NYY=',I3,
+ ' IX=',I5,' IY=',I5,' KREC=',I5,' NPBOX',I3,' ISTRIP',I3)
IF (ONLINE) WRITE (ITOUT,FMT=6022)I,NXX,NYY,IXPIX,IYPIX,KREC,
+ NPBOX,ISTRIP
JDUMP = JDUMP + 1
END IF
C
C
NXY = NXX*NYY
C
C
IF (NXY.GT.MAXR) THEN
WRITE (IOUT,FMT=6144) MAXR,NXX,NYY,NXY
6144 FORMAT (1X,'*** SERIOUS ERROR, CONSULT PROGRAMMER ***',/1X,'Meas',
+ 'urement box larger than expected; MAXR=',I6,
+ ' NX=',I4,' NY=',I4,' NXY=',I4)
IF (ONLINE) WRITE (ITOUT,FMT=6144) MAXR,NXX,NYY,NXY
END IF
C
C
C
C---- Test for new strip of profiles
C
IF (ISTRIP.EQ.ISTRIPCUR) GO TO 310
C
C---- New strip of profiles
C---- Deal with previous strip
C
C---- Skip this if this is the first x strip
C
220 IF (ISTRIPCUR.EQ.0) GO TO 270
C
C---- Increment number of raster boxes, set up sizes and box map
C
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6024) NXX,IXPIX,ISTRIP,NUMBOX
6024 FORMAT (1X,'New strip with NXX=',I4,'at X coord=',I5,
+ ' has ISTRIP=',I3,/1X,
+ ' Starting value for NUMBOX=',I4)
WRITE (IOUT,FMT=6024) NXX,IXPIX,ISTRIP,NUMBOX
END IF
C
C---- Loop over different boxes in this strip
C transfer summed ods stored in mask at array iprofl,
C adding in the ods if this is the second or subsequent film
C to be accumulated.
C
DO 260 J = 1,NYLINE-1
NPBOX = IBOX(ISTRIPCUR,J)
C
C---- First check if this is a real box (virtual boxes, used in variable
C profiles, have negative box numbers)
C
IF (NPBOX.LE.0) GOTO 260
C
C---- Now check that this is a valid area. Some definitions of boundary
C lines will give areas completely outside the detector boundary.
C
IF (.NOT.BOX(NPBOX)) GO TO 260
230 NRF = NRBOX(J)
NWKSP = NWKS(J)
NOVRSP = NOVRS(J)
C
C---- Set up size of this box
C
NXB = ISIZE(NPBOX,1)
NYB = ISIZE(NPBOX,2)
C
C
NXYB = NXB*NYB
C
C---- Dump stored ods if flag set
C
IF (DUMP(2)) THEN
WRITE (IOUT,FMT=6028) NPBOX,NRF,NXB,NYB
6028 FORMAT (//1X,'Box number',I3,' NREF=',I3,' NX=',I2,' NY=',I2,/1X,
+'Summed pixel values in array MASK (unscaled) Y down page,
+X across')
C
MAXPIX = 0
CALL ODPLOT4(MASK(1,J),NXB,NYB,1,MAXPIX)
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6028) NPBOX,NRF,NXB,NYB
MAXPIX = 0
CALL ODPLOT4(MASK(1,J),NXB,NYB,1,MAXPIX)
END IF
C
C
END IF
C
C---- If this box has already been used (on a previous film in
C accumulate mode) form new totals
C
NRFP = NRFBOX(NPBOX)
NRFTOT = NRF + NRFP
NWKTOT = NWK(NPBOX) + NWKSP
NOVRTOT = NOVRL(NPBOX) + NOVRSP
C
C
MAXOD = 0
MINOD = 99999999
C
C---- Transfer averaged profile to I*4 array IPROFL
C If a profile already exists for this box, add new values to old
C skip if no reflections in this box
C
IF (NRF.EQ.0) GO TO 250
C
C
DO 240 K = 1,NXYB
MASKIJ = MASK(K,J)
MASKIJ = MASKIJ +IPROFL(K,NPBOX)
IPROFL(K,NPBOX) = MASKIJ
MAXOD = MAX(MASKIJ,MAXOD)
MINOD = MIN(MASKIJ,MINOD)
240 CONTINUE
C
C
C---- Dont update MAX/MIN if no reflections
C
MAXODBOX(NPBOX) = MAXOD
MINODBOX(NPBOX) = MINOD
C
C
250 NRFBOX(NPBOX) = NRFBOX(NPBOX) + NRF
NOVRL(NPBOX) = NOVRTOT
NWK(NPBOX) = NWKTOT
XCGBOX(NPBOX) = XCGBOX(NPBOX) + XCGSTRIP(J)
YCGBOX(NPBOX) = YCGBOX(NPBOX) + YCGSTRIP(J)
WTBOX(NPBOX) = WTBOX(NPBOX) + WTSTRIP(J)
260 CONTINUE
C
IF (FINISH) GO TO 350
C
C---- Set up list of the central 9 peak pixels to
C be used for rapid evaluation of intensity to select
C reflections to be included in average spot profile
C This needs to be done separately for each new strip
C
C
270 NFBOX = NPFIRST(ISTRIP) - 1
DO 280 J = 1,NYLINE-1
NFBOX = NFBOX + 1
C
C---- Skip if not a valid box
C
IF (.NOT.BOX(NFBOX)) GOTO 280
NYY = ISIZE(NFBOX,2)
C
C---- If using PRUPDATE mode, and this is not the first time through
C the first block of images, need to reassign LRAS to the
C optimised parameters as these were used in MASKIT, unless the box
C was AVERAGEd.
C
IF (PUPDATE) THEN
IF (.NOT.FIRSTBLOCK) THEN
IF (AVERAGE(NFBOX)) THEN
DO 282 K = 3,5
LRAS(K) = IRAS(K)
282 CONTINUE
ELSE
DO 284 K = 3,5
LRAS(K) = IOPTRAS(K-2,NFBOX)
284 CONTINUE
END IF
END IF
END IF
C ************************************
CALL SETMASK(MASK(1,J),LRAS)
CALL PIXLIST(MASK(1,J),LRAS,LISTPIX(1,J))
C ************************************
C
280 CONTINUE
C
C---- Reassign nyy,NPBOX
C
NYY = IBUF(6)
NPBOX = IBUF(7)
C
C---- Zero arrays
C
DO 300 J = 1,NYLINE-1
NRBOX(J) = 0
NOVRS(J) = 0
NDSCR(J) = 0
NWKS(J) = 0
XCGSTRIP(J) = 0.0
YCGSTRIP(J) = 0.0
WTSTRIP(J) = 0.0
C
C
DO 290 K = 1,MAXBOX
MASK(K,J) = 0
290 CONTINUE
300 CONTINUE
C
C
ISTRIPCUR = ISTRIP
C
C*************************************************************************
C---- Finished with the previous strip, now add in this reflection
C for current strip
C Jump straight to this point if this was not the first reflection
C in a new strip
C*************************************************************************
C
C---- Find y index for this spot
C
310 CALL GETYIND(NPBOX,NY)
C
C---- Omit partials from average profiles, unless PARTIALS requested
C on PROFILE card
C
IF (KREC.LT.0 .AND. .NOT.PRPART) GO TO 340
C
C---- Omit summed partials with only one half
C
IF (ISUMPART.EQ.2) GOTO 340
C
C---- Omit summed partials which have been subsequently flagged as
C spatial overlaps
C ****** This won't work properly for the second and subsequent
C images in a block unless we have read in the generate file
C for those images so that IRG is updated ie this works OK
C for reflection integration (below) but NOT for formation of the
C profiles.
C
IRECG = ABS(KREC)
IR = IRG(IRECG)
IF (IR.EQ.2) THEN
IF (DEBUG(18)) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6030) (IH(K),K=1,3), IRECG
IF (ONLINE) WRITE(ITOUT,FMT=6030) (IH(K),K=1,3), IRECG
6030 FORMAT(1X,'Rejecting spatially overlapped reflection',3I5,
+ ' Record number',I6)
END IF
GOTO 340
END IF
C
C---- Sum od.s for given raster size
C
NOVR = 0
C
DO 320 K = 1,NXY
C
C *********
CALL CBYTE2(K)
C *********
C
C Eliminate spots with pixel values le NULLPIX (outside active area)
C and overloads (anywhere within box)
C
IF (IBA.LE.NULLPIX) GOTO 340
C
IF (IBA.GT.PRCUTOFF) NOVR = NOVR + 1
IF (IMGP) THEN
OD(K) = IBA
ELSE
OD(K) = TABLE(IBA)
END IF
320 CONTINUE
C
C---- Eliminate overloads from profile. For summed partials, must
C use flag set up in MEAS before the 2 halves were added
C
IF ((ISUMPART.EQ.1).AND.(ISUMOVER.GE.2)) THEN
IF (DEBUG(18).AND.SPOT) THEN
WRITE(IOUT,FMT=6029) KREC,ISUMOVER,ISUMPART
IF (ONLINE) WRITE(ITOUT,FMT=6029) KREC,ISUMOVER,ISUMPART
6029 FORMAT(1X,'Overloaded summed partial KREC',I6,' ISUMOVER',I3,
+ ' ISUMPART',I3,' pixel values:')
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
NOVRS(NY) = NOVRS(NY) + 1
GO TO 340
ELSE IF (NOVR.GT.NOVPIX) THEN
IF (DEBUG(18).AND.SPOT) THEN
WRITE(IOUT,FMT=6031) KREC,ISUMOVER,ISUMPART
IF (ONLINE) WRITE(ITOUT,FMT=6031) KREC,ISUMOVER,ISUMPART
6031 FORMAT(1X,'Overloaded full reflection, KREC',I6,' ISUMOVER',I3,
+ ' ISUMPART',I3,' pixel values:')
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
NOVRS(NY) = NOVRS(NY) + 1
GO TO 340
END IF
C
C---- Find rapid estimate of intensity
C
C *********************************************
CALL QUICKINT(OD,NXY,LISTPIX(1,NY),PKIRATIO,JDUMP)
C *********************************************
C
C
IF (PKIRATIO.LT.ISDRATIO) THEN
NWKS(NY) = NWKS(NY) + 1
GO TO 340
END IF
C
C---- Add this spot into the profile
C
DO 330 K = 1,NXY
MASK(K,NY) = MASK(K,NY) + OD(K)
330 CONTINUE
C
C---- Now add in contribution of this reflection to weighted profile
C if required
C
IF (WTPROFILE) THEN
C First set up peak/background mask.
C
C---- If using PRUPDATE mode, and this is not the first time through
C the first block of images, need to reassign LRAS to the
C optimised parameters as these were used in MASKIT, unless the box
C was AVERAGEd.
C
IF (PUPDATE) THEN
IF (.NOT.FIRSTBLOCK) THEN
IF (AVERAGE(NPBOX)) THEN
DO 331 K = 3,5
LRAS(K) = IRAS(K)
331 CONTINUE
ELSE
DO 333 K = 3,5
LRAS(K) = IOPTRAS(K-2,NPBOX)
333 CONTINUE
END IF
END IF
END IF
C
CALL SETMASK(MASKW(1),LRAS)
CALL SETSUMS(MASKW(1),LRAS,SUMPQW(1))
C
C---- Now flag the rejected background pixels determined in MASKIT
C or if DENSE image, calculate them
C
IF (DENSE) THEN
IF (FIRSTSP) THEN
MASKMODE = 0
FIRSTSP = .FALSE.
ELSE
MASKMODE = 1
END IF
C
C---- Detemine overlapped pixels for this spot alone, calculating
C PQSUMS and PQSUMINV for use by INTEG3
C
CALL MASKONE(MASKMODE,IXPIX,IYPIX,KREC,LRAS,
+ MASKREJ(1,NPBOX),MASKREJP(1,NPBOX),
+ PQSUMS(1,NPBOX),PQSUMINV(1,NPBOX),XDEBUG,OD)
END IF
NBREJ = MASKREJ(1,NPBOX)
IF (NBREJ.GT.0) THEN
DO 332 N = 1,NBREJ
NP = MASKREJ(N+1,NPBOX)
MASKW(NP) = 0
332 CONTINUE
END IF
C
C---- Now get background plane constants and integrated intensity
C required for weighted profile sums. Note that LMASKREJ is
C not used in this call (it is need when INTEG3 is called from
C BESTMASK)
C
C **********************************************
CALL INTEG3(OD,LRAS,MASKW(1),SUMPQW(1),PQSUMS(1,NPBOX),
+ PQSUMINV(1,NPBOX),NBREJ,LMASKREJ,BGSIG,DEBUG(18))
C **********************************************
C
C
C---- Check that it hasn't rejected too many background points (flagged by
C ASPOT(1)=-9999
C
IF (ABS(ASPOT(1)+9999.0).LT.0.1) GOTO 340
C
C---- Now check for discrimination against strong neighbours
C First set up the mask again but without rejecting any background
C points
IF (DISCRIMINATE) THEN
CALL SETMASK(MASKW(1),LRAS)
C
C---- Now test discrimination
C
IFAIL = 0
CALL DISCR(OD,LRAS,MASKW,DISCRIM,IFAIL)
IF (IFAIL.NE.0) THEN
NDSCR(NY) = NDSCR(NY) + 1
GOTO 340
END IF
END IF
C
C---- Now add contribution of this reflection to weighted profile sums
C for this box
C
C ********************************************
CALL WTPROF(OD,LRAS,SOD,A,B,C,WPROFL(1,NPBOX),
+ WPRSUMS(1,NPBOX))
C ********************************************
C
C---- Sums for mean and rms gradient in each box
C
GRADA(NPBOX) = GRADA(NPBOX) + ASPOT(9)
GRADASQ(NPBOX) = GRADASQ(NPBOX) + ASPOT(9)*ASPOT(9)
GRADB(NPBOX) = GRADB(NPBOX) + ASPOT(10)
GRADBSQ(NPBOX) = GRADBSQ(NPBOX) + ASPOT(10)*ASPOT(10)
END IF
C
C
NRBOX(NY) = NRBOX(NY) + 1
C
C---- Sums for weighted centre of gravity of boxes
C
XCGSTRIP(NY) = XCGSTRIP(NY) + PKIRATIO*IXPIX
YCGSTRIP(NY) = YCGSTRIP(NY) + PKIRATIO*IYPIX
WTSTRIP(NY) = WTSTRIP(NY) + PKIRATIO
C
C---- Sum absolute X,Y for central box
C
IF ((ISTRIP.EQ.ICENSTRIP).AND.(NY.EQ.ICENY)) THEN
XCGCEN = XCGCEN + ABS(PKIRATIO*(NECX-IXPIX))
YCGCEN = YCGCEN + ABS(PKIRATIO*(NECY-IYPIX))
WTCEN = WTCEN + PKIRATIO
END IF
C
340 IF (I.EQ.NREF) THEN
FINISH = .TRUE.
C
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6032)
6032 FORMAT (/1X,'Last reflection has been read, now deal with the la',
+ 'st stripe of profiles')
IF (ONLINE) WRITE (ITOUT,FMT=6032)
END IF
C
C
GO TO 220
END IF
C ********************************************************************
C ********************************************************************
C
C---- End of loop over reflections
C
C ********************************************************************
C ********************************************************************
350 IF (LDUMP) THEN
DO 353 K = 1,80
DEBUG(K) = SDEBUG(K)
NDEBUG(K) = NDEBUGS(K)
353 CONTINUE
LDUMP = .FALSE.
XDEBUG = .FALSE.
END IF
352 CONTINUE
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6034) NUMBOX
6034 FORMAT (/1X,'Total number of Boxes ',I4)
WRITE (IOUT,FMT=6036) ICENBOX,CENTRAL
6036 FORMAT (/1X,'BOX Number for central Unexpanded BOX ',I3,
+ ' CENTRAL is ',L1)
WRITE (IOUT,FMT=6038)
6038 FORMAT (/1X,'BOX Number BOX Indicies Number ',
+ 'of refls Max counts Min counts',
+ ' Optimised raster params'/)
WRITE (IOUT,FMT=6040) (I, (ISIZE(I,J),J=1,2),
+ NRFBOX(I),MAXODBOX(I),
+ MINODBOX(I),(IOPTRAS(K,I),K=1,3),I=1,NUMBOX)
6040 FORMAT (1X,I6,6X,I4,I6,8X,I6,14X,I8,I12,5X,3I3)
WRITE (IOUT,FMT=6046)
6046 FORMAT (/1X,'BOX map, X across, Y down',//)
C
C
DO 360 JDO = NYLINE,1,-1
WRITE (IOUT,FMT=6048) (IBOX(I,JDO),I=1,NXLINE)
6048 FORMAT (1X,40I3)
360 CONTINUE
C
C
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6034) NUMBOX
WRITE (ITOUT,FMT=6036) ICENBOX,CENTRAL
WRITE (ITOUT,FMT=6038)
WRITE (ITOUT,FMT=6040) (I, (ISIZE(I,J),J=1,2),
+ NRFBOX(I),MAXODBOX(I),
+ MINODBOX(I),(IOPTRAS(K,I),K=1,3),I=1,NUMBOX)
WRITE (ITOUT,FMT=6046)
C
C
DO 370 JDO = NYLINE,1,-1
WRITE (ITOUT,FMT=6048) (IBOX(I,JDO),I=1,NXLINE)
370 CONTINUE
C
C
END IF
END IF
C
C---- If accumulating profiles and this is the second pass,
C go back at this point to add in ods from the next film
C unless this is the last film
C
IF (SECONDPASS .AND. NACFILM.LT.NFLMO) THEN
C
C---- Check if the next image is to be skipped
C
372 NOREAD = NOREAD + 1
IF (ISKIPI(NOREAD).NE.0) THEN
IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6001) NOREAD
IF (ONLINE) WRITE(ITOUT,FMT=6001) NOREAD
END IF
CALL SKIPIMG(INMO)
GOTO 372
END IF
READ (INMO) XCEN,YCEN,NREF,MAXR,LNPARTEND
GO TO 210
END IF
C
C
C--- Compute neighbours list for profile averaging
C
C---- Index decides which order the neighbours
C are stored. first is the box itself, followed by 4 nearest
C followed by 4 diagonals
C
C
C
DO 490 I = 1,NUMBOX
C
C---- Skip invalid boxes
C
IF (.NOT.BOX(I)) GOTO 490
C
C---- Get the X and Y indices for this box
C
CALL GETSTRIP(I,IXPIX)
CALL GETYIND(I,IYPIX)
C
C---- Now consider 4 nearest neighbours above,below and on each side
C
INEIGH = 0
C
DO 480 J = -1,1
IXN = IXPIX + J
C
DO 470 K = -1,1
IYN = IYPIX + K
INEIGH = INEIGH + 1
IF ((IXN.GT.NXLINE-1) .OR. (IXN.LT.1) .OR.
+ (IYN.GT.NYLINE-1) .OR. (IYN.LT.1)) GO TO 470
JKBOX = IBOX(IXN,IYN)
C
C---- First check if this is a real box (virtual boxes, used in variable
C profiles, have negative box numbers)
C
IF (JKBOX.LE.0) GOTO 470
C
C---- Test if this is a genuine area
C
IF (.NOT.BOX(JKBOX)) GO TO 470
C
C---- Check if any fully recorded reflections in this box
C
IF (NRFBOX(JKBOX).EQ.0) GO TO 470
IND = INDEX(INEIGH)
NEIGHBOUR(IND,I) = JKBOX
470 CONTINUE
480 CONTINUE
490 CONTINUE
C
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6058) (I, (NEIGHBOUR(J,I),J=1,9),I=1,NUMBOX)
6058 FORMAT (/1X,'List of neighbours',/50 (1X,I4,5X,9I4,/))
IF (ONLINE) WRITE (ITOUT,FMT=6058) (I, (NEIGHBOUR(J,I),J=1,9),
+ I=1,NUMBOX)
END IF
C
C
WRITE (IOUT,FMT=6064)
6064 FORMAT (/1X,'Statistics on the standard PROFILES (before averagi',
+ 'ng)',/)
IF (ONLINE) WRITE (ITOUT,FMT=6064)
C
C---- Absolute X,Y for central box
C
IF (WTCEN.GT.0) THEN
XCGCEN = XCGCEN/WTCEN
YCGCEN = YCGCEN/WTCEN
END IF
C
C ********************************************************************
C ********************************************************************
C---- Loop over boxes, plot profiles, apply rejection criteria
C check background points, reject if necessary and update
C the mask and background sums
C ********************************************************************
C ********************************************************************
C
C
C---- If using DENSE mode, now need to call MASKIT so that the overlapped
C background pixels are set up correctly for optimising the profiles.
C The values currently stored in MASKREJ, PQSUMS, PQSUMINV for each box
C will be those determined for the last spot dealt with in that
C particular box, whereas for optimisation we need to eliminate
C pixels that are overlapped for ANY of the spots contributing to
C the profile. ALSO, BESTMASK calls CHECKMASK which uses the spot
C separations calculated
C
IF (DENSE) THEN
MASKMODE = 1
NREFSAVE = NREF
C
C---- Modify MODE if using optimised raster parameters for pixel overlap.
C
IF (PUPDATE) THEN
IF (FIRSTBLOCK) THEN
MASKMODE = 1
ELSE
MASKMODE = 2
END IF
END IF
CALL MASKIT(MASKMODE,MASK(1,1),IOPTRAS(1,1),AVERAGE(1),
+ MASKREJ(1,1),MASKREJP(1,1),PQSUMS(1,1),PQSUMINV(1,1))
NREF = NREFSAVE
END IF
516 FIRSTBOX = .TRUE.
C
DO 550 JBOX = 1,NUMBOX
C
IF (MOD(JBOX,4).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Resore LRAS to correct inital values as these may have been changed
C by optimisation of a previous profile via call to BGREJECT
DO 518 K = 3,5
LRAS(K) = IRAS(K)
518 CONTINUE
C
C---- First time through, set up mask for central box, required
C in evaluation of correlation coefficient. Put this in MASK(1,2)
C
IF (JBOX.EQ.1) THEN
NXX = ISIZE(ICENBOX,1)
NYY = ISIZE(ICENBOX,2)
C
C---- If using PRUPDATE mode, and this is not the first time through
C the first block of images, need to reassign LRAS to the
C optimised parameters.
C
IF (PUPDATE) THEN
IF (.NOT.FIRSTBLOCK) THEN
DO 519 K = 3,5
LRAS(K) = IOPTRAS(K-2,ICENBOX)
519 CONTINUE
END IF
END IF
C
C ***********************
CALL SETMASK(MASK(1,2),LRAS)
C ***********************
C
END IF
C
C---- Skip if not a valid box
C
IF (.NOT.BOX(JBOX)) GOTO 550
NRF = NRFBOX(JBOX)
NRFBOXW(JBOX) = NRF
NXX = ISIZE(JBOX,1)
NYY = ISIZE(JBOX,2)
NXY = NXX*NYY
C
C
C---- If using PRUPDATE mode, and this is not the first time through
C the first block of images, need to reassign LRAS to the
C optimised parameters as these were used in MASKIT, unless the box
C was AVERAGEd.
C
IF (PUPDATE) THEN
IF (.NOT.FIRSTBLOCK) THEN
IF (AVERAGE(JBOX)) THEN
DO 521 K = 3,5
LRAS(K) = IRAS(K)
521 CONTINUE
ELSE
DO 523 K = 3,5
LRAS(K) = IOPTRAS(K-2,JBOX)
523 CONTINUE
END IF
END IF
END IF
C **********************************
CALL SETMASK(MASK(1,1),LRAS)
CALL SETSUMS(MASK(1,1),LRAS,SUMPQ(1,1))
C **********************************
C
C
C---- Set up background sums for this box
C******* NO LONGER DO THIS BECAUSE PQSUMS HAS BEEN SET UP BY MASKIT *******
C**** PQSUMS(1,JBOX) = SUMPQ(2,1)
C**** PQSUMS(2,JBOX) = SUMPQ(4,1)
C**** PQSUMS(6,JBOX) = SUMPQ(6,1)
C
C---- Transfer summed pixel values to I*4 array OD
C
DO 520 K = 1,NXY
OD(K) = IPROFL(K,JBOX)
520 CONTINUE
C
C
NRBX = NRF
C
C
C** IF (((.NOT.ACCUMULATE).AND. (NXY.GT.MAXR)) .OR.
C** + (ACCUMULATE.AND. (NXY.GT.MAXMAXR))) THEN
IF (NXY.GT.MAXR) THEN
WRITE (IOUT,FMT=6144) MAXR,NXX,NYY,NXY
IF (ONLINE) WRITE (ITOUT,FMT=6144) MAXR,NXX,NYY,NXY
END IF
C
C
FULL = .TRUE.
C
C---- Initialise
C
DELX = 0.0
DELY = 0.0
RMSBG = 0.0
AX = 0.0
BX = 0.0
CX = 0.0
BGDEVMAX = 0.0
R = 0.0
ASPOT(1) = 0.0
C
C---- Calculate mean and rms gradient for this box for use in spot
C rejection
C
IF (NRF.GT.0) THEN
GMEAN = GRADA(JBOX)/NRF
GRMS = SQRT(GRADASQ(JBOX)/NRF-GMEAN*GMEAN)
GRADA(JBOX) = GMEAN
GRADASQ(JBOX) = GRMS
GMEAN = GRADB(JBOX)/NRF
GRMS = SQRT(GRADBSQ(JBOX)/NRF-GMEAN*GMEAN)
GRADB(JBOX) = GMEAN
GRADBSQ(JBOX) = GRMS
END IF
C
C---- Calculate correlation coefficient for peak area between
C this profile and central profile.
C
NXB = ISIZE(ICENBOX,1)
NYB = ISIZE(ICENBOX,2)
C
C *****************************************
IF (NRBX.NE.0) CALL CORRELATE(OD,LRAS,IPROFL(1,ICENBOX),
+ MASK(1,2),NXB,NYB,R)
C *****************************************
C
C---- Find scale factor to scale profile in the range 0-255
C
RANGE = FLOAT((MAXODBOX(JBOX)-MINODBOX(JBOX)))
SCAL = 0.0
IF (RANGE.NE.0.0) SCAL = 255.0/RANGE
C
C---- Test and reject bad background points
C this requires recalculating the background plane
C and if required (CHANGEMASK) updating PQSUMS and PQSUMINV.
C Optimised raster parameters are also calculated (if requested)
C by a call to BESTMASK from BGREJECT and returned in IOPTRAS,
C and LRAS and MASK will also be updated.
C
C *********************************************************
522 IF (NRBX.NE.0) CALL BGREJECT(OD(1),MASK(1,1),LRAS,JBOX,
+ MASKREJ(1,JBOX),SUMPQ(1,1),
+ PQSUMS(1,JBOX),PQSUMINV(1,JBOX),PRBGSIG,
+ CHANGEMASK,FULL,NRBX,IOPTRAS(1,JBOX),CBOX(JBOX),
+ TOLBOX(JBOX),DENSE)
C *********************************************************
C
IF (DEBUG(18)) THEN
NBREJ = MASKREJ(1,JBOX)
WRITE(IOUT,FMT=6063) JBOX,LRAS,GRADA(JBOX),GRADASQ(JBOX),
+ GRADB(JBOX),GRADBSQ(JBOX),(SUMPQ(K,1),K=1,6),
+ (PQSUMS(K,JBOX),K=1,6),(PQSUMINV(K,JBOX),K=1,9),
+ (IOPTRAS(K,JBOX),K=1,3),MASKREJP(1,JBOX),
+ NBREJ,(MASKREJ(K,JBOX),K=2,NBREJ+1)
IF (ONLINE) WRITE(ITOUT,FMT=6063) JBOX,LRAS,
+ GRADA(JBOX),GRADASQ(JBOX),GRADB(JBOX),GRADBSQ(JBOX),
+ (SUMPQ(K,1),K=1,6),
+ (PQSUMS(K,JBOX),K=1,6),(PQSUMINV(K,JBOX),K=1,9),
+ (IOPTRAS(K,JBOX),K=1,3),MASKREJP(1,JBOX),
+ NBREJ,(MASKREJ(K,JBOX),K=2,NBREJ+1)
6063 FORMAT(/1X,'Summary for profile box',I3,1X,'Raster',5I5,/,1X,
+ 'Mean and rms gradient in X',F6.1,' (',F5.1,')',' in Y',
+ F6.1,' (',F5.1,')',/,1X,
+ 'SUMPQ',6F10.0,/,1X,
+ 'PQSUMS',6F10.0,/,1X,'PQSUMINV',9F9.5,/,1X,'Optimised ',
+ 'raster parameters NC,NRX,NRY',3I4,/,1X,'Number of ',
+ 'rejected peak pixels',I4,/,1X,'Number of ',
+ 'rejected background pixels',I4,' Pixel numbers',/,
+ (1X,16I5))
END IF
C---- Test that it has not rejected an unacceptable number of
C background points. In S/R INTEG ensures at least
C NBGMIN background pixels left, and if not, flagged with ASPOT(1)=-9999
C
IF (ABS(ASPOT(1)+9999.0).LT.0.1) THEN
WRITE(IOUT,6065) JBOX,NBGMIN
WRITE(ISUMMR,6065) JBOX,NBGMIN
IF (ONLINE) WRITE(ITOUT,6065) JBOX,NBGMIN
IF (BRIEF) WRITE(IBRIEF,6065) JBOX,NBGMIN
6065 FORMAT(//1X,'For profile',I3,
+ ' there are fewer than',I4,' background pixels remaining'/,
+ 1X,'after rejection (the minimum acceptable number is',
+ ' set by MINB on REJECTION',
+ ' keyword)',/,1X,'It is possible that ',
+ ' the minimum spot separation ',
+ '(SEPARATION keyword) is too small',/,1X,'or the',
+ ' optimisation of the measurement box parameters has ',
+ 'produced',/,1X,'profiles that are too wide',/,1X,
+ 'If the spots really are very close, you may wish to ',
+ 'use the SEPARATION CLOSE option (eg SEPARATION 1.0 1.0',
+ ' CLOSE)',/,1X,'In addition it is sometimes best to ',
+ 'suppress optimisation of the raster parameters of ',
+ 'individual standard profiles',
+ ' (PROFILE NOOPT)',/,1X,'although the raster parameters',
+ ' for the profile in the',
+ ' centre of the detector will still be optimised.',/,1X,
+ 'See help library for further details.')
IF (RECOVER) THEN
CALL GETMOREBG(OD,LRAS,MASK(1,1),MASKREJ(1,JBOX),
+ PQSUMS(1,JBOX),PQSUMINV(1,JBOX),JBOX)
GOTO 522
ELSE
CALL SHUTDOWN
END IF
END IF
RMSBGA(JBOX) = RMSBG*SCAL
C
C---- Add the box shift to delx and dely
C
DELX = (DELX+IXSHIFT)/FACT
DELY = (DELY+IYSHIFT)/FACT
C
C---- Check against criteria for averaging profiles
C
AVERAGE(JBOX) = ((SCAL*RMSBG.GT.RMSBGPR) .OR. (NRBX.LT.NRFMIN))
C
C
C---- For profiles which are NOT flagged to be averaged (because optimisation
C may not be reliable) find the largest spot size in X and Y.
C
IF (.NOT.AVERAGE(JBOX)) THEN
XWIDTH = MAX(XWIDTH,(0.01*(LRAS(1)-2*LRAS(4))/FACT))
YWIDTH = MAX(YWIDTH,(0.01*(LRAS(2)-2*LRAS(5))/FACT))
END IF
C---- Set up weighted profile for this box. Note that
C the updated (if optimising raster parameters) LRAS
C will be used. The profile sums (PROFSUMS) are evaluated after
C transferring profile into IPROFL to avoid rounding errors.
C
C *********************************************
IF (WTPROFILE.AND.(NRBX.NE.0))
+ CALL WPRSETUP(LRAS,WPROFL(1,JBOX),
+ WPRSUMS(1,JBOX),MASK(1,1))
C *********************************************
C
C
IF (DUMP(2).AND.WTPROFILE) THEN
DO 530 K = 1,NXY
IWPROFL(K) = WPROFL(K,JBOX) + 0.5
530 CONTINUE
WRITE(IOUT,FMT=6067) JBOX
6067 FORMAT(//1X,'Weighted profile for box',I3,'after scaling',
+ ' max to 10000')
MAXPIX = 0
LMASKREJP(1) = 0
C CALL ODPLOT4(IWPROFL(1),NXX,NYY,1,MAXPIX)
CALL ODPLOT4R(IWPROFL(1),NXX,NYY,1,MASK(1,1),MASKREJ(1,JBOX),
+ MASKREJP(1,JBOX),LMASKREJP,MAXPIX)
END IF
C
IF ((FIRSTBOX) .OR. (DEBUG(18))) THEN
FIRSTBOX = .FALSE.
WRITE (IOUT,FMT=6066)
6066 FORMAT (3X,'BOX XMIN XMAX YMIN YMAX NX NY RMSBG DELX',
+ ' DELY NO A B C DEVMAX NBGREJ NOV',
+ 'ER NWK CORRLN')
IF (ONLINE) WRITE (ITOUT,FMT=6066)
END IF
C
C---- Convert box limits to mm
C
C ******************************************
CALL RASTOMM(IXBOX,IYBOX,ILIM,JBOX,NMASKS)
C ******************************************
C
RMSBGBOX(JBOX) = SCAL*RMSBG
IF (NRBX.NE.0) THEN
C
C---- Convert background plane constants to average values per spot
AX = A/NRBX
BX = B/NRBX
CX = C/NRBX
C
C---- Total background for this box
C
CBOX(JBOX) = C
C
C---- Centre of gravity of box
C
XCGBOX(JBOX) = XCGBOX(JBOX)/WTBOX(JBOX)
YCGBOX(JBOX) = YCGBOX(JBOX)/WTBOX(JBOX)
END IF
IF (ONLINE) WRITE (ITOUT,FMT=6068) JBOX, (ILIM(K),K=1,4),
+ NXX,NYY,SCAL*RMSBG,0.01*DELX,0.01*DELY,NRBX,AX,BX,CX,
+ SCAL*BGDEVMAX,MASKREJ(1,JBOX),NOVRL(JBOX),
+ NWK(JBOX),R
6068 FORMAT (5I5,1X,2I5,F6.1,2F8.3,I5,2F8.2,F7.1,F6.1,2X,I5,I7,
+ I4,F7.3)
WRITE (IOUT,FMT=6068) JBOX, (ILIM(K),K=1,4),
+ NXX,NYY,SCAL*RMSBG,0.01*DELX,0.01*DELY,NRBX,AX,BX,CX,
+ SCAL*BGDEVMAX,MASKREJ(1,JBOX),NOVRL(JBOX),
+ NWK(JBOX),R
C
C---- It is possible for a box to contain no acceptable full
C reflections, hence this test
C
IF (NRF.EQ.0) GO TO 550
C
C---- Set up standard profile (background corrected and scaled to
C maximum of 10000) for this box in array IPROFL using values
C in array OD. NOTE that OD is returned as background subtracted
C values from this S/R.
C ********************************************************
CALL STDPROF(OD(1),LRAS,MASK(1,1),IPROFL(1,JBOX),SCALE,ODMIN)
C ********************************************************
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6070) SCALE,ODMIN
6070 FORMAT (1X,'Profile scale factor',F15.5,' and OFFSET',F12.1)
IF (ONLINE) WRITE (ITOUT,FMT=6070) SCALE,ODMIN
END IF
C
C
PRSCALE(JBOX,1) = SCALE
PRSCALE(JBOX,2) = ODMIN
C
C---- Save original values of scale,odmin,rmsbg, required to print
C unaveraged profile if averaging is done
C
SAVESCAL(JBOX,1) = PRSCALE(JBOX,1)
SAVESCAL(JBOX,2) = PRSCALE(JBOX,2)
SAVERMS(JBOX) = RMSBGBOX(JBOX)
C
IF (.NOT.DUMP(2)) GO TO 550
C
C---- Dump stored ods if flag set
C
WRITE (IOUT,FMT=6072) JBOX,NRF,NXX,NYY
6072 FORMAT (//1X,'Profile ',I3,' NREF=',I3,' NX=',I2,' NY=',I2,/1X,
+ 'This is the summed counts, scaled to a maximum of 10000,',
+ ' but before background subtraction',/,1X,
+ 'This is NOT the weighted profile',/,1X,
+'Profile values, Y down page, X across')
C
MAXPIX = 0
CALL ODPLOT4(IPROFL(1,JBOX),NXX,NYY,1,MAXPIX)
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6072) JBOX,NRF,NXX,NYY
MAXPIX = 0
CALL ODPLOT4(IPROFL(1,JBOX),NXX,NYY,1,MAXPIX)
END IF
C
C
C
C---- End of loop over boxes
C
550 CONTINUE
C
C
C---- Store max spot size
C
XWARN(3,1) = XWIDTH
XWARN(4,1) = YWIDTH
C
C---- Set up new masks allowing for spot overlap now using the optimised
C raster parameters. This returns rejected
C background pixels in MASKREJ and modified background sums in
C PQSUMS and PQSUMINV for each mask.
C Note that MASKIT calls GENSORT which will update NREF so
C save the correct value.
C Note also we need to do this BEFORE averaging the profiles
C Note that the optimised raster parameters are NOT used for
C profiles flagged for averaging as they may be unreliable.
C
IF (PROPT) THEN
C
C---- If this is the first BLOCK of images, and this is the first time the
C profiles have been determined, then go back and redetermine them
C but now using the optimised raster parameters when MASKIT is called.
C
IF (FIRSTBLOCK.AND.PUPDATE) THEN
WRITE(IOUT,FMT=6017)
IF (ONLINE) WRITE(ITOUT,FMT=6017)
6017 FORMAT(/1X,'Now repeating formation of standard profiles but',
+ ' using the optimised raster parameters')
FIRSTBLOCK = .FALSE.
NOREAD = 0
REWIND(INMO)
IF (DENSE) REWIND(ICOORD)
GOTO 14
END IF
C
C---- This should be done even if DENSE is true I think
C
IF (.NOT.DENSE) THEN
MASKMODE = 3
NREFSAVE = NREF
CALL MASKIT(MASKMODE,MASK(1,1),IOPTRAS(1,1),AVERAGE(1),
+ MASKREJ(1,1),MASKREJP(1,1),PQSUMS(1,1),PQSUMINV(1,1))
NREF = NREFSAVE
END IF
END IF
C
C---- Test for more than 50% background pixels overlapped by neighbouring
C spots in not in DENSE mode
C
IF (.NOT.DENSE) THEN
DO 552 J = 1,NUMBOX
IF (.NOT.BOX(J)) GOTO 552
X = 0.0
NTOTBOX = MASKREJ(1,J) + PQSUMS(6,J)
IF (NTOTBOX.NE.0) X = REAL(MASKREJ(1,J))/REAL(NTOTBOX)
WARN(21) = (WARN(21).OR.(X.GT.0.5))
XWARN(1,21) = MAX(XWARN(1,21),X)
552 CONTINUE
END IF
C
C
IF (WARN(1).AND.(.NOT.PWARN1)) THEN
WRITE(IOUT,FMT=6019)
IF (ONLINE) WRITE(ITOUT,FMT=6019)
6019 FORMAT(1X,'**** WARNING **** Peaks of neighbouring reflections',
+ ' overlap, data quality will be impaired')
PWARN1 = .TRUE.
END IF
C---- ************************************************************
C---- ************************************************************
C---- Loop over boxes and perform profile averaging where required
C---- ************************************************************
C---- ************************************************************
C
NBOXAV = 0
C
C
DO 590 JBOX = 1,NUMBOX
C
C---- Skip if not a valid box
C
IF (MOD(JBOX,4).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
IF (.NOT.BOX(JBOX)) GOTO 590
C
IF (.NOT.AVERAGE(JBOX)) GO TO 590
WARN(8) = .TRUE.
NBOXAV = NBOXAV + 1
C
IF (NBOXAV.EQ.1) THEN
WRITE (IOUT,FMT=6074)
6074 FORMAT (/1X,'Statistics on averaged profiles',/)
IF (ONLINE) WRITE (ITOUT,FMT=6074)
WRITE (IOUT,FMT=6066)
IF (ONLINE) WRITE (ITOUT,FMT=6066)
END IF
C
C
IF (NBOXAV.GT.NMASKS) THEN
NWRN = NWRN + 1
WRITE (IOUT,FMT=6076) NMASKS
6076 FORMAT(//1X,'***** ERROR *****',/1X,'The number of boxes that ',
+ 'require averaging exceeds the maximum of',I3,/,1X,
+ 'This means that the images are very weak, and there',
+ ' are a number of',/,1X,'possible solutions:',/,1X,
+ '1) Accumulate the profiles over a larger number of ',
+ 'images.',/,1X,'This is subkeyword BLOCK on PACK keyword.',
+ /,1X,'2) If the mosaic spread plus beam divergence is',
+ ' large compared to',/,1X,'the rotation angle per image',
+ ' there will be very few fully',/,1X,'recorded ',
+ 'reflections per image.',/,1X,'Use the ADDPART keyword so',
+ ' that partials on abutting images are summed.',
+ /,1X,'3) Reduce the number of standard profiles. The',
+ ' boundaries of the',/,1X,'areas over which the standard'
+ ,' profiles are formed can be defined',/,1X,'using ',
+ 'subkeywords XLINES and YLINES on PROFILE keyword.',/,1X,
+ '4) Reduce the resolution limit (RESOLUTION).')
IF (ONLINE) WRITE (ITOUT,FMT=6076) NMASKS
CALL SHUTDOWN
END IF
C
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6078) JBOX
6078 FORMAT (///1X,'Forming average profile for box',I3)
WRITE (IOUT,FMT=6078) JBOX
END IF
C
C
NXX = ISIZE(JBOX,1)
NYY = ISIZE(JBOX,2)
NXY = NXX*NYY
C
C **********************************
CALL SETMASK(MASK(1,1),LRAS)
CALL SETSUMS(MASK(1,1),LRAS,SUMPQ(1,1))
C **********************************
C
C---- Set up background sums for this box
C (these may have been changed in bgtest in previous loop)
C
PQSUMS(1,JBOX) = SUMPQ(2,1)
PQSUMS(2,JBOX) = SUMPQ(4,1)
PQSUMS(6,JBOX) = SUMPQ(6,1)
C
IPASS = 1
C
C---- Transfer averaged ods to I*4 array OD
C
C
DO 560 K = 1,NXY
OD(K) = IPROFL(K,JBOX)
560 CONTINUE
C
C---- Form averaged profile using neighbouring boxes. The averaged
C profile is returned in array OD
C
C ********************************************************
570 CALL MEANPRO(OD,JBOX,NEIGHBOUR(1,JBOX),IPASS,NOVRL,NWK,
+ MAXOD,MINOD,NRFSAVE,NOVRLSAVE,NWKSAVE,SAVESCAL,
+ CBOX,CBOXAV)
C ********************************************************
C
C
C---- Get a merged list of rejected background pixels
C
CALL GETREJ(JBOX,IPASS,NEIGHBOUR(1,JBOX),MASK(1,1),MASKREJ,
+ MASKREJAV(1,NBOXAV))
MAXODBOX(JBOX) = MAXOD
MINODBOX(JBOX) = MINOD
C
C---- Find scale factor to scale profile in range 0-255
C
SCAL = 0.0
RANGE = FLOAT((MAXODBOX(JBOX)-MINODBOX(JBOX)))
IF (RANGE.NE.0.0) SCAL = 255.0/RANGE
NRBX = NRFSAVE(JBOX)
FULL = .TRUE.
C
C---- Test and reject bad background points
C this requires recalculating the background plane
C and if required (changemask) updating pqsums and pqsuminv
C NOTE: The profiles have now been background subtracted,
C so we can no longer use the counting statistics estimate of
C the expected background variation to reject background pixels.
C This will therefore be done based on the rms variation. Flag
C this by setting PRBGSIG -ve.
CAL + MASKREJ(1,JBOX),SUMPQ(1,1),
C *********************************************************
572 IF (NRBX.NE.0) CALL BGREJECT(OD(1),MASK(1,1),LRAS,JBOX,
+ MASKREJAV(1,NBOXAV),SUMPQ(1,1),
+ PQSUMS(1,JBOX),PQSUMINV(1,JBOX),-PRBGSIG,
+ CHANGEMASK,FULL,NRBX,IOPTRAS(1,JBOX),CBOXAV(JBOX),
+ TOLBOX(JBOX),DENSE)
C *********************************************************
IF (DEBUG(18)) THEN
NBREJ = MASKREJAV(1,NBOXAV)
WRITE(IOUT,FMT=6063) JBOX,LRAS,
+ GRADA(JBOX),GRADASQ(JBOX),GRADB(JBOX),GRADBSQ(JBOX),
+ (SUMPQ(K,1),K=1,6),
+ (PQSUMS(K,JBOX),K=1,6),(PQSUMINV(K,JBOX),K=1,9),
+ (IOPTRAS(K,JBOX),K=1,3),MASKREJP(1,JBOX),
+ NBREJ,(MASKREJAV(K,NBOXAV),K=2,NBREJ+1)
IF (ONLINE) WRITE(ITOUT,FMT=6063) JBOX,LRAS,
+ GRADA(JBOX),GRADASQ(JBOX),GRADB(JBOX),GRADBSQ(JBOX),
+ (SUMPQ(K,1),K=1,6),
+ (PQSUMS(K,JBOX),K=1,6),(PQSUMINV(K,JBOX),K=1,9),
+ (IOPTRAS(K,JBOX),K=1,3),MASKREJP(1,JBOX),
+ NBREJ,(MASKREJAV(K,NBOXAV),K=2,NBREJ+1)
END IF
C---- Test that it has not rejected an unacceptable number of
C background points. In S/R INTEG ensures at least
C NBGMIN background pixels left, and if not, flagged with ASPOT(1)=-9999
C
C
IF (ABS(ASPOT(1)+9999.0).LT.0.1) THEN
WRITE(IOUT,6065) JBOX,NBGMIN
IF (ONLINE) WRITE(ITOUT,6065) JBOX,NBGMIN
IF (BRIEF) WRITE(IBRIEF,6065) JBOX,NBGMIN
IF (RECOVER) THEN
CALL GETMOREBG(OD,LRAS,MASK(1,1),MASKREJAV(1,NBOXAV),
+ PQSUMS(1,JBOX),PQSUMINV(1,JBOX),JBOX)
GOTO 572
ELSE
CALL SHUTDOWN
END IF
END IF
C
RMSBGA(JBOX) = RMSBG*SCAL
C
C---- Add box shift to delx,dely
C
DELX = (DELX+IXSHIFT)/FACT
DELY = (DELY+IYSHIFT)/FACT
C
C
C---- Apply rejection criteria
C
IF ((SCAL*RMSBG.GT.RMSBGPR) .OR. (NRBX.LT.NRFMIN)) THEN
IPASS = IPASS + 1
IF (IPASS.GT.2) GO TO 580
GO TO 570
END IF
C
C
580 IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6066)
IF (ONLINE) WRITE (ITOUT,FMT=6066)
END IF
C
C---- Calculate correlation coefficient for peak area between
C this profile and central profile.
C
R = 0.0
C
NXB = ISIZE(ICENBOX,1)
NYB = ISIZE(ICENBOX,2)
C
C *****************************************
IF (NRBX.NE.0) CALL CORRELATE(OD,LRAS,IPROFL(1,ICENBOX),
+ MASK(1,2),NXB,NYB,R)
C *****************************************
C
C---- Convert box limits to mm
C
C ******************************************
CALL RASTOMM(IXBOX,IYBOX,ILIM,JBOX,NMASKS)
C ******************************************
C
RMSBGBOX(JBOX) = SCAL*RMSBG
IF (NRBX.NE.0) THEN
AX = A/NRBX
BX = B/NRBX
CX = C/NRBX
END IF
IF (ONLINE) WRITE (ITOUT,FMT=6068) JBOX, (ILIM(K),K=1,4),
+ NXX,NYY,SCAL*RMSBG,0.01*DELX,0.01*DELY,NRBX,AX,BX,CX,
+ SCAL*BGDEVMAX,MASKREJAV(1,NBOXAV),NOVRLSAVE(JBOX),
+ NWKSAVE(JBOX),R
WRITE (IOUT,FMT=6068) JBOX, (ILIM(K),K=1,4),
+ NXX,NYY,SCAL*RMSBG,0.01*DELX,0.01*DELY,NRBX,AX,BX,CX,
+ SCAL*BGDEVMAX,MASKREJAV(1,NBOXAV),NOVRLSAVE(JBOX),
+ NWKSAVE(JBOX),R
C
C
IF ((IPASS.GT.2).AND.(.NOT.WTPROFILE)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6080)
6080 FORMAT (1X,'*** Still rejects this profile ***',/1X,'You may wan',
+ 't to change the rejection criteria (keywords RMSBG and N',
+ 'REF)',/1X,'Reflections in this measurement box will be s',
+ 'imply integrated and not profile fitted in the integrati',
+ 'on pass')
WRITE (IOUT,FMT=6080)
C
C---- Rejected profile, set all peak pixels to 1000 and all background
C pixels to 0
C
C ***********************************************
CALL TOPHAT(OD(1),LRAS,MASK(1,1))
C ***********************************************
C
C---- Need to assign background plane constants for the modified values
C in OD (0 and 1000) becasue these are used in STDPROF. A,B,C passed
C via ASPOT in /SUMS/
C
A = 0.0
B = 0.0
C = 0.0
C
NOPROFILE(JBOX) = .TRUE.
END IF
C
C---- Profile now acceptable
C Set up standard profile (background corrected and scaled to
C maximum of 10000) for this box in array IPRSAVE using values
C in array OD. NOTE that OD is returned as background subtracted
C values from this S/R.
C
C ***********************************************************
CALL STDPROF(OD(1),LRAS,MASK(1,1),IPRSAVE(1,NBOXAV),SCALE,ODMIN)
C ***********************************************************
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6070) SCALE,ODMIN
IF (ONLINE) WRITE (ITOUT,FMT=6070) SCALE,ODMIN
END IF
C
C
PRSCALE(JBOX,1) = SCALE
PRSCALE(JBOX,2) = ODMIN
C
C---- If weighted summed profiles are to be used, form the averaged profiles
C from the neighbouring weighted profiles, weighting each one with the
C inverse variance in background plane fit (for unweighted profile).
C First set up the list of profiles to be used in IPRNUM then the weights
C in WTPR. Average over the same number of neighbours as used in MEANPRO
C (ie if IPASS.EQ.1, the nearest 4, if IPASS.EQ.2 then the nearest 8)
C
CAL IF (WTPROFILE.AND.IPASS.LE.2) THEN
C
IF (WTPROFILE) THEN
WTPRSUM = 0.0
IFLG = 1
NNEIGHB = 5
IF (IPASS.GE.2) NNEIGHB = 9
DO 582 K = 1,9
WTPR(K) = 0.0
IF (K.GT.NNEIGHB) GOTO 582
IWTBOX = NEIGHBOUR(K,JBOX)
IPRNUM(K) = IWTBOX
IF (IWTBOX.EQ.0) GOTO 582
RMSBG = SAVERMS(IWTBOX)
IF (RMSBG.NE.0) WTPRK = 1.0/(RMSBG*RMSBG)
WTPRSUM = WTPRSUM + WTPRK
WTPR(K) = WTPRK
582 CONTINUE
C
C---- Normalise the weights
C
DO 584 K = 1,9
IF (WTPRSUM.NE.0.0) WTPR(K) = WTPR(K)/WTPRSUM
584 CONTINUE
C
C---- Get averaged profile and store in IPRSAVE. Also stores a composite
C list of rejected background pixels (the sum of those for all
C profiles used in forming the average) in MASKREJAV.
C
C **********************************************************
CALL GETPROF(IFLG,JBOX,IPRNUM,WTPR,MASK(1,1),MASKREJ,
+ IPRSAVE(1,NBOXAV),PROFSUMS(1,JBOX),
+ WPROFSUMS(1,JBOX),MASKREJAV(1,NBOXAV),PQSUMSPOT,
+ PQSUMINVSPOT,XDEBUG)
C **********************************************************
END IF
C
C
IF (.NOT.DUMP(2)) GO TO 588
WRITE (IOUT,FMT=6072) JBOX
IF (ONLINE) WRITE (ITOUT,FMT=6072) JBOX
C
C ********************************************
CALL RASPLOT4(IPRSAVE(1,NBOXAV),NXX,NYY,MASK(1,1),
+ MASKREJAV(1,NBOXAV),IDR)
C
588 IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6168) JBOX,(PROFSUMS(K,JBOX),K=1,4),
+ (WPROFSUMS(K,JBOX),K=1,4)
IF (ONLINE) WRITE(ITOUT,FMT=6168) JBOX,
+ (PROFSUMS(K,JBOX),K=1,4),(WPROFSUMS(K,JBOX),K=1,4)
6168 FORMAT(1X,'For profile',I3,' PROFSUMS',4F12.0,/,16X,
+ 'WPROFSUMS',4F12.0)
END IF
590 CONTINUE
C
C---- ************************************************************
C---- ************************************************************
C---- END OF Loop over boxes averaging profiles where required
C---- ************************************************************
C---- ************************************************************
C
NBOXAV = 0
C
IF (DENSE) THEN
WRITE(IOUT,FMT=6171)
IF (ONLINE) WRITE(ITOUT,FMT=6171)
ELSE
WRITE(IOUT,FMT=6173)
IF (ONLINE) WRITE(ITOUT,FMT=6173)
END IF
6171 FORMAT(/,1X,'In the following profiles, background pixels are',
+ ' indictated by a "-" sign and rejected',
+ ' background pixels (due to',/,1X,'overlap by a ',
+ 'neighbouring spot) are indicated by a "*". Pixels with',
+ ' negative values are denoted by a "]".'/,1X,'Note that ',
+ 'a background pixel is shown as being rejected if it is',
+ ' overlapped by a neighbouring spot for ANY',/,1X,
+ 'reflection in that area of the detector. However, ',
+ 'because the SEPARATION CLOSE option is being used',
+ ' overlapped',/,1X,'pixels will be determined separately',
+ ' for every spot, and most spots will have far fewer',
+ ' overlapped pixels than',/,1X,'shown here.')
6173 FORMAT(/,1X,'In the following profiles, background pixels are',
+ ' indictated by a "-" sign and rejected',
+ ' background pixels (due to',/,1X,'overlap by a ',
+ 'neighbouring spot) are indicated by a "*". Pixels with',
+ ' negative values are denoted by a "]".'/,1X,'Note that ',
+ 'a background pixel is rejected if it is overlapped by',
+ ' a neighbouring spot for ANY reflection in that',/,1X,
+ ' area of the detector.',/,1X,'If too many background',
+ ' pixels are being rejected try the SEPARATION CLOSE ',
+ 'keywords (see help library)')
C
IF (BRIEF) WRITE(IBRIEF,FMT=6170)
6170 FORMAT(/1X,'The standard profiles have been determined')
C
FIRSTBOX = .TRUE.
C
C---- ******************************************************************
C---- ******************************************************************
C
C---- Loop over boxes transferring saved averaged profiles in
C iprsave back into iprofl and correcting all profiles for the
C offset iodmin, so that the mean background value is now
C zero. If weighted profiles are to be used, transfer them into
C IPROFL arrays and evaluate PROFSUMS and WPROFSUMS
C---- ******************************************************************
C---- ******************************************************************
C
IWARN(1,20) = 0
C
DO 610 JBOX = 1,NUMBOX
C
C---- Skip if not a valid box
C
IF (.NOT.BOX(JBOX)) GOTO 610
C
NXX = ISIZE(JBOX,1)
NYY = ISIZE(JBOX,2)
NXY = NXX*NYY
C
C---- Set up optimised raster box parameters
C
IF (PROPT) THEN
LRAS(3) = IOPTRAS(1,JBOX)
LRAS(4) = IOPTRAS(2,JBOX)
LRAS(5) = IOPTRAS(3,JBOX)
END IF
C
C ***********************
CALL SETMASK(MASK(1,1),LRAS)
C ***********************
C
IF (AVERAGE(JBOX)) THEN
NBOXAV = NBOXAV + 1
C
C---- Print unaveraged profile if requested (if there are
C any reflections)
C
IF (LPRINT(11) .AND. (NRFBOX(JBOX).GT.0)) THEN
SCALE = SAVESCAL(JBOX,1)
ODMIN = SAVESCAL(JBOX,2)
C
C---- Remove the offset in profile so that mean background would
C be zero. Rescale to a maximum of 10000.
C Evaluate and store sums for this profile
C ***************************************************
CALL SCALEPROF(IPROFL(1,JBOX),LRAS,MASK(1,1),MASKREJ(1,JBOX),
+ SCALE,ODMIN,PROFSUMS(1,JBOX),WPROFSUMS(1,JBOX))
C ***************************************************
C
C---- Calculate the profile factor for this profile
C call setsums to get number of peak pixels
C
C **********************************
CALL SETSUMS(MASK(1,1),LRAS,SUMPQ(1,1))
C **********************************
C
NPK = NINT(SUMPQ(5,1))
SIGMAP = PROFSUMS(3,JBOX)
SIGMAPSQ = PROFSUMS(4,JBOX)
PRFACT = SIGMAP*SIGMAP/ (NPK*SIGMAPSQ)
PROFACT(JBOX) = PRFACT
C
C---- Convert box limits to mm
C
C ******************************************
CALL RASTOMM(IXBOX,IYBOX,ILIM,JBOX,NMASKS)
C ******************************************
C
WRITE (IOUT,FMT=6082) JBOX, (ILIM(K),K=1,4),NRFBOX(JBOX),
+ SAVERMS(JBOX),PRFACT
6082 FORMAT (//1X,'Profile for box',I3,' *** Before averaging ***',/1X,
+ 'X Limits',I4,' to',I4,' mm, Y limits',I4,' to',I4,' mm, ',
+ /,1X,'Number of reflections in profile',I5,' RMSBG',F5.1,
+ ' Profile Factor ',F4.2)
C
IF (ONLINE) WRITE (ITOUT,FMT=6082) JBOX, (ILIM(K),K=1,4),
+ NRFBOX(JBOX),SAVERMS(JBOX),PRFACT
IF (BRIEF) WRITE (IBRIEF,FMT=6082) JBOX, (ILIM(K),K=1,4),
+ NRFBOX(JBOX),SAVERMS(JBOX),PRFACT
C
C---- If using weighted profile, transfer WPROFL into IWPROFL and plot
C this
C
IF (WTPROFILE) THEN
DO 598 K = 1,NXY
IWPROFL(K) = WPROFL(K,JBOX)
598 CONTINUE
C ******************************************
CALL RASPLOT4(IWPROFL,NXX,NYY,MASK(1,1),
+ MASKREJ(1,JBOX),IDR)
C ******************************************
C
ELSE
C ******************************************
CALL RASPLOT4(IPROFL(1,JBOX),NXX,NYY,MASK(1,1),
+ MASKREJ(1,JBOX),IDR)
C ******************************************
END IF
IF (BRIEF.AND.(.NOT.GRAPH)) CALL MPAUSE
C
END IF
C
C---- Update nref,nwk,novrl from saved totals in s/r meanpro
C
NRFBOX(JBOX) = NRFSAVE(JBOX)
NOVRL(JBOX) = NOVRLSAVE(JBOX)
NWK(JBOX) = NWKSAVE(JBOX)
C
C---- Now deal with averaged profile. NOTE that for weighted profiles,
C this next step is transferring the averaged weighted profile into
C IPROFL
C
DO 600 K = 1,NXY
IPROFL(K,JBOX) = IPRSAVE(K,NBOXAV)
600 CONTINUE
C
C---- Now move the composite rejected pixel list from MASKREJAV into
C MASKREJ
C
NBREJ = MASKREJAV(1,NBOXAV) + 1
DO 601 K = 1,NBREJ
MASKREJ(K,JBOX) = MASKREJAV(K,NBOXAV)
601 CONTINUE
C
END IF
SCALE = PRSCALE(JBOX,1)
ODMIN = PRSCALE(JBOX,2)
C
C---- Remove the offset in profile so that mean background would
C be zero. rescale to a maximum of 10000.
C Evaluate and store sums for this profile.
C Do NOT do this for weighted profiles, because IPROFL contains the
C weighted profile for averaged boxes, not the summed profile.
IF (.NOT.WTPROFILE) THEN
C ***************************************************
CALL SCALEPROF(IPROFL(1,JBOX),LRAS,MASK(1,1),MASKREJ(1,JBOX),
+ SCALE,ODMIN,PROFSUMS(1,JBOX),WPROFSUMS(1,JBOX))
C ***************************************************
IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6085) JBOX,(PROFSUMS(K,JBOX),K=1,4),
+ (WPROFSUMS(K,JBOX),K=1,4)
IF (ONLINE) WRITE(ITOUT,FMT=6085) JBOX,
+ (PROFSUMS(K,JBOX),K=1,4),(WPROFSUMS(K,JBOX),K=1,4)
END IF
6085 FORMAT(1X,'Scaling profile for box',I3,/,1X,
+ 'Array PROFSUMS',4F12.0,/,1X,'WPROFSUMS',4F12.0)
END IF
C
C---- If weighted summed profiles are to be used, move them into
C IPROFL reevaluate PROFSUMS and WPROFSUMS now.
C Note that WPROFSUMS contains the sums over all box excluding
C only background rejected pixels.
C Do not transfer into IPROFL for averaged profiles because this
C transfer has already been done above (DO 600 LOOP)
C
IF (WTPROFILE.AND.(NRFBOXW(JBOX).GT.0)) THEN
IF (.NOT.AVERAGE(JBOX)) THEN
DO 602 K = 1,NXY
IPROFL(K,JBOX) = WPROFL(K,JBOX) + 0.5
602 CONTINUE
END IF
C
C *******************************************************
CALL PRUPDATE(LRAS,MASK(1,1),MASKREJ(1,JBOX),IPROFL(1,JBOX),
+ PROFSUMS(1,JBOX),WPROFSUMS(1,JBOX),NLOWPK)
C *******************************************************
IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6083) JBOX,(PROFSUMS(K,JBOX),K=1,4),
+ (WPROFSUMS(K,JBOX),K=1,4),NLOWPK
IF (ONLINE) WRITE(ITOUT,FMT=6083) JBOX,
+ (PROFSUMS(K,JBOX),K=1,4),(WPROFSUMS(K,JBOX),K=1,4),
+ NLOWPK
END IF
6083 FORMAT(1X,'Moving over weighted profile for box',I3,/,1X,
+ 'Array PROFSUMS',4F12.0,/,1X,'WPROFSUMS',4F12.0,
+ /1X,'NLOWPK',I5)
END IF
C
C---- Check number of background points, increase if necessary
C
IF ((NINT(PQSUMS(6,JBOX)).LT.RECLEVEL*NBGMIN)
+ .AND.(RECOVER)) THEN
CALL GETMOREBG(IPROFL(1,JBOX),LRAS,MASK(1,1),MASKREJ(1,JBOX),
+ PQSUMS(1,JBOX),PQSUMINV(1,JBOX),JBOX)
END IF
C
C---- Calculate the profile factor for this profile
C call setsums to get number of peak pixels
C
C **********************************
CALL SETSUMS(MASK(1,1),LRAS,SUMPQ(1,1))
C ***********************************
C
NPK = NINT(SUMPQ(5,1))
SIGMAP = PROFSUMS(3,JBOX)
SIGMAPSQ = PROFSUMS(4,JBOX)
PRFACT = SIGMAP*SIGMAP/ (NPK*SIGMAPSQ)
PROFACT(JBOX) = PRFACT
C
C---- Warning about profiles having long tails
C
LOWPKFR = REAL(NLOWPK)/REAL(NPK)
WARN(11) = (WARN(11).OR.(LOWPKFR.GT.0.3))
XWARN(1,11) = MAX(XWARN(1,11),LOWPKFR)
C
C---- Warning about profiles having a high percentage of profile counts
C outside the peak area. PROFSUMS(3) is sum of profile in peak only,
C WPROFSUMS(3) is sum over entire box excluding rejected background
C
IF (WTPROFILE) THEN
PRFRAC = 0.0
IF (WPROFSUMS(3,JBOX).GT.0)
+ PRFRAC = (WPROFSUMS(3,JBOX) - PROFSUMS(3,JBOX))/
+ WPROFSUMS(3,JBOX)
WARN(20) = (WARN(20).OR.PRFRAC.GT.0.10)
IF (PRFRAC.GT.0.1) THEN
K = IWARN(1,20)
IF (K.LT.19) THEN
IWARN(K+2,20) = JBOX
XWARN(K+2,20) = PRFRAC
END IF
IWARN(1,20) = IWARN(1,20) + 1
END IF
END IF
C
C---- Print all profiles if requested
C
IF (LPRINT(11)) THEN
C
C---- Convert box limits to mm
C
C ******************************************
CALL RASTOMM(IXBOX,IYBOX,ILIM,JBOX,NMASKS)
C *******************************************
C
WRITE (IOUT,FMT=6084) JBOX, (ILIM(K),K=1,4),NRFBOX(JBOX),
+ RMSBGBOX(JBOX),PRFACT
6084 FORMAT (//1X,'Profile for box',I3,/1X,'X limits',I4,' to',I4,' m',
+ 'm, Y limits',I4,' to',I4,' mm',/,1X,'Number of ',
+ 'reflections in profile',I5,' RMSBG',F5.1,
+ ' Profile factor ',F4.2)
IF (ONLINE) WRITE (ITOUT,FMT=6084) JBOX, (ILIM(K),K=1,4),
+ NRFBOX(JBOX),RMSBGBOX(JBOX),PRFACT
IF (BRIEF) WRITE (IBRIEF,FMT=6084) JBOX, (ILIM(K),K=1,4),
+ NRFBOX(JBOX),RMSBGBOX(JBOX),PRFACT
C
C ******************************************
CALL RASPLOT4(IPROFL(1,JBOX),NXX,NYY,MASK(1,1),
+ MASKREJ(1,JBOX),IDR)
C ******************************************
C
IF (BRIEF.AND.(.NOT.GRAPH)) CALL MPAUSE
C
END IF
C
C
IF (DUMP(2).OR.DUMP(7)) THEN
WRITE (IOUT,FMT=6086) JBOX
IF (ONLINE) WRITE (ITOUT,FMT=6086) JBOX
6086 FORMAT (//1X,'Array IPROFL for box',I3,/)
IF (WTPROFILE) THEN
WRITE(IOUT,6087)
IF (ONLINE) WRITE(ITOUT,6087)
END IF
6087 FORMAT(1X,'This is the WEIGHTED profile, not the SUMMED one')
MAXPIX = 0
C CALL ODPLOT4(IPROFL(1,JBOX),NXX,NYY,IDR,MAXPIX)
CALL ODPLOT4R(IPROFL(1,JBOX),NXX,NYY,1,MASK(1,1),
+ MASKREJ(1,JBOX),MASKREJP(1,JBOX),LMASKREJP,MAXPIX)
C
END IF
C
C---- Now get a gradient for all profiles, used in scaling up standard
C deviation estimates to allow for instrument errors.
C
IHX = LRAS(1)/2
IHY = LRAS(2)/2
IXRIM = LRAS(4)
IYRIM = LRAS(5)
CALL PROFGRAD(IPROFL(1,JBOX),IHX,IHY,IXRIM,IYRIM,PRGRAD(JBOX))
C
FIRSTBOX = .FALSE.
C
610 CONTINUE
C
C
C---- Finally, check that all the standard profiles have at least 2*NBGMIN
C background pixels, but if in DENSE mode skip this test.
C
IF (.NOT.DENSE) THEN
DO 612 JBOX = 1,NUMBOX
IF (.NOT.BOX(JBOX)) GOTO 612
IF (NINT(PQSUMS(6,JBOX)).LT.2*NBGMIN) THEN
WRITE(IOUT,FMT=6091) JBOX, NINT(PQSUMS(6,JBOX)), 2*NBGMIN
WRITE(ISUMMR,FMT=6091) JBOX, NINT(PQSUMS(6,JBOX)), 2*NBGMIN
IF (ONLINE) WRITE(ITOUT,FMT=6091) JBOX, NINT(PQSUMS(6,JBOX)),
+ 2*NBGMIN
6091 FORMAT(//1X,'***** FATAL ERROR *****',/,1X,'Profile number',
+ I3,' has only',I3,' background pixels after rejecting',/,1X,
+ 'pixels which are overlapped by neighbouring peaks which',
+ ' is less than',/,1X,'the minimum acceptable (',I3,' which',
+ ' is twice the value set by MINB on',/,1X,'REJECTION',
+ ' keyword)',/,1X,'Either the minimum spot separation ',
+ '(SEPARATION keyword) is too small',/,1X,'or the',
+ ' optimisation of the measurement box parameters has ',
+ 'produced',/,1X,'profiles that are too wide',/,1X,
+ 'If the spots really are very close, you may wish to ',
+ 'use the TRIM and OVERLAP',/,1X,'subkeywords of the ',
+ 'SEPARATION keyword...see help library for details.',/,1X,
+ 'Read suggestions below for the best way to proceed')
CALL SHUTDOWN
END IF
612 CONTINUE
END IF
C
IF (DENSE) REWIND(ICOORD)
REWIND INMO
C
NOREAD = 0
C
C---- Check if the next image is to be skipped
C
614 NOREAD = NOREAD + 1
IF (ISKIPI(NOREAD).NE.0) THEN
IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6001) NOREAD
IF (ONLINE) WRITE(ITOUT,FMT=6001) NOREAD
END IF
CALL SKIPIMG(INMO)
GOTO 614
END IF
C
C---- Read XCEN etc for first film
C
READ (INMO) XCEN,YCEN,NREF,MAXR,LNPARTEND
C
C--- END OF IMPERIAL SPOT PROFILE
C*************************************************************
C
C---- If keyword set, write profiles and associated data to
C logical file 'profile'
C
IF (PRSAVE) THEN
CALL PROFWRITE(MASKREJ,PQSUMS,PQSUMINV,PROFSUMS,WPROFSUMS,
+ RMSBGA,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,CENTRAL,IOPTRAS)
END IF
C
C---- If using variable profiles, set up the quadrilaterals used to
C define which profiles are to be used in forming the average
C profile.
IF (VARPRO) THEN
MODE = 0
XR = 0.0
YR = 0.0
CALL VARPROF(MODE,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,
+ CENTRAL,XR,YR,NUMBOX,IPRNUM,WTPR)
MODE = 1
END IF
C
C---- Start calculation of integrated intensities
C
630 CONTINUE
C
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6092) XCEN,YCEN,NREF,MAXR
6092 FORMAT (//1X,'Now integrating intensities, XCEN,YCEN,NREF,MAXR',
+ 2F7.1,2I6)
WRITE (IOUT,FMT=6092) XCEN,YCEN,NREF,MAXR
END IF
C
C
IFAIL = 1
IF (ONLINE)
C
C ********************************
+ CALL CCPOPN(-46,'BADSPOT',2,2,80,IFAIL)
C ********************************
C
NBAD = 0
NBADPK = 0
ISTRIPCUR = 0
NGO = 1
JBOX = 0
NREXP = 0
BGREXP = 0.0
C
C---- Sums for instrument error correction
C
ASUM = 0.0
BSUM = 0.0
NSUMR = 0
PKREJS = 0.0
WPX = IRAS(1) - (IRAS(4)+1)*2
WPY = IRAS(2) - (IRAS(5)+1)*2
BOXFAC = (((WPX+1)/ (WPY+1))**2)*
+ ((WPY**2)*3.0 + WPY**3 + 5*WPY + 3)/12.0
C
JDUMP = 0
C
C Flag true if detector error factor has been assigned a value
C This allows dumping pixel values for "badspots"
C
ERRSET = (EFAC.GT.-900)
IF (ERRSET) ERRINST = EFAC*EFAC
NMINTR = 0
C
C---- Flag for GETPROF
C
IFLG = 0
C
IF (FIRSTFILM.AND.BRIEF) THEN
WRITE(IBRIEF,FMT=6005)
END IF
C
C **********************************************************************
C **********************************************************************
C---- Loop over reflexions and integrate.
C **********************************************************************
C **********************************************************************
C
C---- Initialise counters for mean number of additional background pixels
C rejected
C
NREJSUM = 0
SUMREJ = 0.0
SUMBG = 0.0
NHALF = 0
NSUMPART = 0
FIRSTSP = .TRUE.
C
DO 772 I = 1,NREF
XDEBUG = .FALSE.
C
IF (MOD(I,250).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Read ods for this spot from mosflm.out
C
READ (INMO) LEN,IBUF
C
C *********************
CALL PREAD(BOXOD,LEN,INMO)
C *********************
C
CALL RECUNPACK(IBUF(1),KREC)
IXPIX = IBUF(3)
IYPIX = IBUF(4)
IRECG = ABS(KREC)
C
C---- Omit summed partials which have been subsequently flagged as
C spatial overlaps
C
IR = IRG(IRECG)
IF (IR.EQ.2) THEN
IF (DEBUG(18)) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6030) (IH(K),K=1,3), IRECG
IF (ONLINE) WRITE(ITOUT,FMT=6030) (IH(K),K=1,3), IRECG
END IF
NSPOVL = NSPOVL + 1
GOTO 772
END IF
C
C---- Test for dumpspot (set by keyword BAD)
C
IF (DUMPSPOT) THEN
C
C---- Compare indices with list in IHD, set LDUMP true if match found
C and turn on DEBUG in all subroutines
C **************************
CALL COMPR(KREC,IHD,LDUMP,NHKLD)
C **************************
C
KDUMP = .FALSE.
IF (DUMPALL.AND.(I.GE.NDSTART).AND.(JDUMP.LE.NDTOT)
+ .AND.((IXPIX.GE.IXDMIN).AND.(IXPIX.LE.IXDMAX))
+ .AND.((IYPIX.GE.IYDMIN).AND.(IYPIX.LE.IYDMAX)))
+ KDUMP = .TRUE.
C
C---- Test for resolution limts set
C
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
IF (DSTSQ.NE.0.0) DSPOT = 1.0/SQRT(DSTSQ)
MDUMP = ((DSPOT.LE.RESDLOW).AND.(DSPOT.GE.RESD))
C
C---- If positional restrictions given, apply them, but given
C indices are dumped independent of position.
C
IF (DUMPALL) LDUMP = (LDUMP.OR.KDUMP)
C
C---- If resolution limits given, they MUST be satisfied for dumping
C
IF (RESD.NE.0.0) LDUMP = (LDUMP.AND.MDUMP)
C
IF (LDUMP) THEN
XDEBUG = .TRUE.
DO 771 K=1,80
SDEBUG(K) = DEBUG(K)
NDEBUGS(K) = NDEBUG(K)
DEBUG(K) = .TRUE.
NDEBUG(K) = NDTOT
771 CONTINUE
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6093) (IH(K),K=1,3),DSPOT
IF (ONLINE) WRITE(ITOUT,FMT=6093) (IH(K),K=1,3),DSPOT
6093 FORMAT(/,1X,'***************************************',
+ '***************************************',
+ /,1X,'Dumping reflection',3I5,' Resolution',F6.2)
END IF
END IF
C
C---- If the "process" keyword was given, subroutine gensort will
C not have been called and hence IGFLAG(I) will not have been set.
C Also, when accumulating profiles, the IGFLAG values are read in
C for all contributing images and therefore we no longer have
C the values for this image in memory (In fact IGFLAG is set to
C all zero's because of this problem).
C
IF (PROCES) IGFLAG(IRECG) = 1
C
C---- If the B or C films were used to form the profiles, then the MINT
C criterion cannot be applied in GENSORT and all reflections are
C written to MOSFLM.OUT (SPOTOD), so apply MINT test here
C
IF (((PRBFILM.AND.BFILM).OR. (PRCFILM.AND.CFILM)) .AND.
+ INTG(IRECG).LT.MINT) THEN
C
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6094) I,IRECG,INTG(IRECG),MINT
6094 FORMAT (1X,'REF NUMB',I5,' IRECG',I5,' INT',I6,' MINT',I5)
WRITE (IOUT,FMT=6094) I,IRECG,INTG(IRECG),MINT
END IF
C
C
IPNTR(I) = 100*KREC
IGFLAG(IRECG) = 0
NMINTR = NMINTR + 1
GO TO 770
END IF
C
C
FULL = .FALSE.
IF (KREC.LT.0) GO TO 640
FULL = .TRUE.
NOFR = NOFR + 1
640 NXX = IBUF(5)
NPBOX = IBUF(7)
C
C---- Flag for summed partial, =1 for summed partial, else 0
C
ISUMPART = IBUF(8)
IF (ISUMPART.EQ.1) NSUMPART = NSUMPART + 1
C
C A flag for overloaded summed partials ONLY
C = 0 If not an overload
C = 1 if overloaded for integration only
C = 2 if overload for profile fitting only
C = 3 if overload for integration and profile fitting
C
ISUMOVER = IBUF(9)
C
CALL GETSTRIP(NPBOX,ISTRIP)
C
C---- Test for new strip of profiles
C
IF (ISTRIP.EQ.ISTRIPCUR) GO TO 670
C
C---- Set up limits of box numbers and box expansion for this strip
C code is different if profiles have been determined
C
ISTRIPCUR = ISTRIP
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6096) ISTRIP,IXPIX,NXX
6096 FORMAT (1X,'STRIP',I3,' Starts at IX=',I5,' NXX=',I4)
WRITE (IOUT,FMT=6096) ISTRIP,IXPIX,NXX
C
C---- Set up all possible masks for this strip
C
WRITE (IOUT,FMT=6098) ISTRIP,MAXR
6098 FORMAT (1X,'Setting up masks at ISTRIP=',I3,' MAXR=',I6)
IF (ONLINE) WRITE (ITOUT,FMT=6098) ISTRIP,MAXR
END IF
C
C
NFBOX = NPFIRST(ISTRIP) - 1
C
DO 660 K = 1,NYLINE-1
C
NFBOX = NFBOX + 1
C
C---- Test for valid boxes
C
IF (.NOT.BOX(NFBOX)) GOTO 660
NYY = ISIZE(NFBOX,2)
NXY = NXX*NYY
C
C---- Set up optimised raster box parameters
C
IF (PROPT) THEN
LRAS(3) = IOPTRAS(1,NFBOX)
LRAS(4) = IOPTRAS(2,NFBOX)
LRAS(5) = IOPTRAS(3,NFBOX)
END IF
C
IF (NYY.GT.MAXDIM) GO TO 670
C
C ***********************
CALL SETMASK(MASK(1,K),LRAS)
C ***********************
C
C
C---- Note that if background points have been rejected from the
C mask, the background sums in SUMPQ(2,4 and 6) will
C not be correct, but these values are not used in
C background plane determination so it doesnt matter
C (uses pqsums instead)
C ***********************************
CALL SETSUMS(MASK(1,K),LRAS,SUMPQ(1,K))
C ***********************************
C
C--- If changemask,
C see if any background points have been rejected, and if so
C update the mask
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6100) K,NFBOX,LRAS,(SUMPQ(J,K),J=1,6)
6100 FORMAT (1X,'Y INDEX=',I3,' NFBOX',I3,' Raster parameters',5I4,/,
+ 1X,'SUMPQ ',6F10.0)
IF (ONLINE) WRITE (ITOUT,FMT=6100) K,NFBOX,LRAS,
+ (SUMPQ(J,K),J=1,6)
END IF
C
IF (.NOT.CHANGEMASK) GO TO 660
NBREJ = MASKREJ(1,NFBOX)
IF (NBREJ.EQ.0) GO TO 660
C
C
IF (DEBUG(18)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6102) NBREJ,NFBOX
6102 FORMAT (/1X,I4,' Background points rejected for BOX',I3)
WRITE (IOUT,FMT=6102) NBREJ,NFBOX
END IF
C
C
DO 650 N = 1,NBREJ
NP = MASKREJ(N+1,NFBOX)
MASK(NP,K) = 0
650 CONTINUE
C
C---- End of loop over box expansion
C
660 CONTINUE
C
C
670 NYY = IBUF(6)
IF (NXX.GT.MAXDIM .OR. NYY.GT.MAXDIM) GO TO 730
NXY = NXX*NYY
C
C
IF (NXY.GT.MAXR) THEN
WRITE (IOUT,FMT=6144) MAXR,NXX,NYY,NXY
IF (ONLINE) WRITE (ITOUT,FMT=6144) MAXR,NXX,NYY,NXY
END IF
C
C
CALL GETYIND(NPBOX,NY)
TPEAK = SUMPQ(5,NY)
C
C---- Set up rim raster parameters for this reflection (only used by MASKONE)
C
IF (PROPT) THEN
DO 676 K = 3,5
LRAS(K) = IOPTRAS(K-2,NPBOX)
676 CONTINUE
ELSE
DO 678 K = 3,5
LRAS(K) = IRAS(K)
678 CONTINUE
END IF
C
C
C---- Pack KREC and NPBOX into IPNTR
C
IPNTR(I) = 100*KREC + SIGN(NPBOX,KREC)
C
C---- If profiles have been read from a file, it is possible to
C get a reflection which has no corresponding measurement box.
C this reflection will be treated as unmeasured
C
IF (NPBOX.EQ.0) THEN
NWRN = NWRN + 1
NNOBOX = NNOBOX + 1
IF (ONLINE) WRITE (ITOUT,FMT=6104) I,NPBOX,NY,NXX,NYY,
+ IXPIX,IYPIX
6104 FORMAT (1X,'NO Profile box for reflection',I3,' with NPBOX=',I3,
+ ' NY=',I3,' NXX=',I3,' NYY=',I3,' IX,IY ',2I5)
WRITE (IOUT,FMT=6104) I,NPBOX,NY,NXX,NYY,IXPIX,IYPIX
ISDG(IRECG) = -9999
INTG(IRECG) = -9999
IPRO(IRECG) = -9999
ISDPRO(IRECG) = -9999
GO TO 770
END IF
C
C---- Must get TBGND =number of background points from PQSUMS
C rather than SUMPQ in case points have been rejected
C
TBGND = PQSUMS(6,NPBOX)
C
C---- Read densities for one spot
C correct densities
C
NOVR = 0
NOFFEDG = 0
OVRLFIT = .FALSE.
EDGEFIT = .FALSE.
C
C
DO 680 K = 1,NXY
C
C *********
CALL CBYTE2(K)
C *********
C
C---- Test for pixel le NULLPIX (outside active area) or pixels above cutoff
C in the peak region
C
IF (IBA.LE.NULLPIX) NOFFEDG = NOFFEDG + 1
IF ((IBA.GT.CUTOFF).AND.(MASK(K,NY).EQ.1)) NOVR = NOVR + 1
IF (IMGP) THEN
OD(K) = IBA
ELSE
OD(K) = TABLE(IBA)
END IF
680 CONTINUE
C
C---- Overloads, either reject or profile fit if keyword set
C For summed partials, must use flag set up in MEAS before the
C 2 halves were added. Otherwise just test number of pixels
C above cutoff
C
IF (ADDPART.AND.((ISUMOVER.EQ.1).OR.(ISUMOVER.EQ.3))) THEN
IF (DEBUG(18).AND.SPOT) THEN
WRITE(IOUT,FMT=6029) KREC,ISUMOVER,ISUMPART
IF (ONLINE) WRITE(ITOUT,FMT=6029) KREC,ISUMOVER,ISUMPART
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
IF (USEOVRLD) THEN
NOLO = NOLO + 1
OVRLFIT = .TRUE.
ELSE
GO TO 750
END IF
ELSE IF (NOVR.GT.NOVPIX) THEN
IF (DEBUG(18).AND.SPOT) THEN
WRITE(IOUT,FMT=6031) KREC,ISUMOVER,ISUMPART
IF (ONLINE) WRITE(ITOUT,FMT=6031) KREC,ISUMOVER,ISUMPART
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
IF (USEOVRLD) THEN
NOLO = NOLO + 1
OVRLFIT = .TRUE.
ELSE
GO TO 750
END IF
END IF
C
C---- Reflections partially off edge of scanned area (ie containing
C pixels with value 0 (Image plate only)
C Reject if more than half pixels are off edge
C
IF (NOFFEDG.GT.0) THEN
IF (USEDGE) THEN
NXYH = NXY/2
IF (NOFFEDG.GT.NXYH) GOTO 740
NEDGE1 = NEDGE1 + 1
EDGEFIT = .TRUE.
ELSE
GOTO 740
END IF
END IF
C
C
C---- Omit summed partials with only one half
C
IF (ISUMPART.EQ.2) GOTO 738
C
IF (PROFILE .AND. CHANGEMASK) NBREJ = MASKREJ(1,NPBOX)
C
C---- Get degree of partiality for partials, needed for weighted profile
C fit and for analysis (below)
C
IPART = IMG(IRECG)
IF ((.NOT.FULL).AND.(IPART.EQ.0)) THEN
WRITE(IOUT,FMT=6101)
IF (ONLINE) WRITE(ITOUT,FMT=6101)
6101 FORMAT(1X,'*** ERROR ***',/,1X,'Partial reflection with',
+ ' zero degree of partiality detected',/,1X,'To allow ',
+ 'program to continue partiality has been set to 0.01',
+ /,1X,'Please inform Andrew Leslie of this error')
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6203) (IH(K),K=1,3),IRECG,IPART
IF (ONLINE) WRITE(ITOUT,FMT=6203) (IH(K),K=1,3),IRECG,IPART
6203 FORMAT(1X,'ZERO PARTIAL, indices',3I4,' IRECG=',I5,' IPART=',
+ I3)
IPART = 1
END IF
C
C
C---- SET XDEBUG HERE FOR EXTENSIVE DEBUG OUTPUT
C
CAL IF (I.EQ.2335) XDEBUG = .TRUE.
BADPROF = .FALSE.
C
C---- If using variable profiles,set up the weighted profile for
C this box
IF (VARPRO) THEN
XR = IXPIX
YR = IYPIX
CALL VARPROF(MODE,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,
+ CENTRAL,XR,YR,NPBOX,IPRNUM,WTPR)
C
C---- Store the weighted profile in NUMBOX+1 slot in IPROFL and sums
C in PROFSUMS. Summed rejected pixels (for all contributing profiles)
C are stored in LMASKREJ returned by GETPROF
C
IWTBOX = NUMBOX + 1
C **********************************************************
CALL GETPROF(IFLG,NPBOX,IPRNUM,WTPR,MASK(1,NY),
+ MASKREJ,
+ IPROFL(1,IWTBOX),PROFSUMS(1,IWTBOX),
+ WPROFSUMS(1,IWTBOX),LMASKREJ,
+ PQSUMSPOT,PQSUMINVSPOT,XDEBUG)
C
C---- Reset TBGND, number of background pixels
C
TBGND = PQSUMSPOT(6)
C
C---- Now flag the rejected background pixels determined in MASKIT
C or if DENSE image, calculate them
C
IF (DENSE) THEN
IF (FIRSTSP) THEN
MASKMODE = 0
FIRSTSP = .FALSE.
ELSE
MASKMODE = 1
END IF
C
C---- Detemine overlapped pixels for this spot alone, calculating
C LMASKREJ,LMASKREJP,PQSUMS and PQSUMINV for use by INTEG2
C
CALL MASKONE(MASKMODE,IXPIX,IYPIX,KREC,LRAS,
+ LMASKREJ,MASKREJP(1,NPBOX),
+ PQSUMSPOT,PQSUMINVSPOT,XDEBUG,OD)
C
C---- Reset TBGND, number of background pixels
C
TBGND = PQSUMSPOT(6)
C
C---- Set up LMASK
C
C ***********************
CALL SETMASK(LMASK,LRAS)
C ***********************
NBREJ = LMASKREJ(1)
IF (NBREJ.NE.0) THEN
DO 681 N = 1,NBREJ
NP = LMASKREJ(N+1)
LMASK(NP) = 0
681 CONTINUE
END IF
END IF
C
C---- Check number of background points, increase if necessary.
C GETMOREBG returns an UPDATED list of rejected background pixels
C in LMASKREJ.
C
IF ((NINT(PQSUMSPOT(6)).LT.RECLEVEL*NBGMIN)
+ .AND.(RECOVER)) THEN
RECOVERED = .TRUE.
IF (XDEBUG) THEN
N = NXY - NINT(TPEAK)
WRITE(IOUT,FMT=6119) NXY,NINT(TPEAK),N,LMASKREJ(1)
IF (ONLINE) WRITE(ITOUT,FMT=6119) NXY,NINT(TPEAK),N,
+ LMASKREJ(1)
END IF
6119 FORMAT(1X,'Total number of pixels',I5,' Peak pixels',I5,
+ ' background pixels',I5,' of which',I5,' rejected')
CALL GETMOREBG(IPROFL(1,IWTBOX),LRAS,MASK(1,NY),
+ LMASKREJ,PQSUMSPOT,PQSUMINVSPOT,I)
C
C---- Reset TBGND, number of background pixels
C
TBGND = PQSUMSPOT(6)
END IF
C
C---- If additional pixels have been rejected, need to create a new
C MASK array for this spot. If GETMOREBG has been called, need
C to set ALL rejected background pixels to OK initially, then
C use new list stored in LMASKREJ to reset them. This is because
C GETMOREBG can reclassify a previously rejected background pixel
C as being OK, whereas GETPROF will only ADD new rejected pixels.
C
C---- DO NOT DO THIS IF DENSE is TRUE as LMASK ahs been set up already
C
IF (.NOT.DENSE) THEN
DO 682 N = 1,NXY
LMASK(N) = MASK(N,NY)
IF (RECOVERED.AND.LMASK(N).EQ.0) LMASK(N) = -1
682 CONTINUE
C WRITE(6,*),'MASKREJ',(MASKREJ(N,NPBOX),N=1,NBREJ)
C WRITE(6,*),'NBREJ,LMASKREJ(1),NXY',NBREJ,LMASKREJ(1),NXY
IF ((CHANGEMASK.AND.(LMASKREJ(1).NE.NBREJ)).OR.RECOVERED)THEN
RECOVERED = .FALSE.
NBREJ = LMASKREJ(1)
C WRITE(6,*),'LMASKREJ',(LMASKREJ(N),N=1,NBREJ)
DO 684 N = 1,NBREJ
NP = LMASKREJ(N+1)
LMASK(NP) = 0
C WRITE(6,*),'REJECT PIXEL, number',NP,N
684 CONTINUE
END IF
END IF
C **********************************************************
CALL INTEG2(OD,IPROFL(1,IWTBOX),LRAS,LMASK,
+ LMASKREJ,MASKREJP(1,NPBOX),LMASKREJP,
+ MASKREJO,SUMPQ(1,NY),PQSUMSPOT,
+ PQSUMINVSPOT,PROFSUMS(1,IWTBOX),
+ WPROFSUMS(1,IWTBOX),
+ IDR,NBREJ,BGSIG,FULL,IPART,WEIGHT,OVRLFIT,
+ CUTOFF,EDGEFIT,ISUMPART,PKWDLIM1,PKWDLIM2,PKWDLIM3,
+ XDEBUG,PKONLY,PKWDOUTL,IOUTL1,IOUTL2,DECONV,BADSPOT)
C **********************************************************
ELSE
C **********************************************************
CALL INTEG2(OD,IPROFL(1,NPBOX),LRAS,MASK(1,NY),
+ MASKREJ(1,NPBOX),MASKREJP(1,NPBOX),LMASKREJP,
+ MASKREJO,SUMPQ(1,NY),PQSUMS(1,NPBOX),
+ PQSUMINV(1,NPBOX),PROFSUMS(1,NPBOX),
+ WPROFSUMS(1,NPBOX),IDR,NBREJ,BGSIG,FULL,IPART,
+ WEIGHT,OVRLFIT,CUTOFF,EDGEFIT,ISUMPART,
+ PKWDLIM1,PKWDLIM2,PKWDLIM3,XDEBUG,PKONLY,
+ PKWDOUTL,IOUTL1,IOUTL2,DECONV,BADSPOT)
C **********************************************************
END IF
C
C---- Count number of spots with rejected peak pixels due to poor profile fit
C
IF (LMASKREJP(1).GT.0) NBADPK = NBADPK + 1
IF (LDUMP) THEN
K = NINT(ASPOT(13))
IF ((K.GT.IDMIN).AND.(K.LT.IDMAX)) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6105) (IH(K),K=1,3),NPBOX,NY,LRAS,
+ (SUMPQ(K,NY),K=1,6),
+ (PQSUMS(K,NPBOX),K=1,6),(PQSUMINV(K,NPBOX),K=1,9),
+ NBREJ
IF (ONLINE) WRITE(ITOUT,FMT=6105) (IH(K),K=1,3),NPBOX,NY,
+ LRAS,(SUMPQ(K,NY),K=1,6),
+ (PQSUMS(K,NPBOX),K=1,6),(PQSUMINV(K,NPBOX),K=1,9),
+ NBREJ
6105 FORMAT(/1X,'Integrating reflection',3I5,/,1X,
+ 'Profile box',I3,'Y index',I3,' Raster',5I5,/,1X,
+ 'SUMPQ',6F10.0,/,1X,
+ 'PQSUMS',6F10.0,/,1X,'PQSUMINV',9F9.5,/,1X,
+ 'Number of rejected background pixels',I4)
END IF
END IF
C
C---- Check that background under peak is not negative
C
IF (ASPOT(2).LT.0.0) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6103) I,(IH(K),K=1,3),ASPOT(2),IDIVIDE
IF (ONLINE) WRITE(ITOUT,FMT=6103) I,(IH(K),K=1,3),ASPOT(2),
+ IDIVIDE
6103 FORMAT(1X,'** FATAL ERROR **',/,1X,'Reflection record number',
+ I6,' indices',3I4,/,1X,'The total background counts',
+ ' under the peak region has',/,1X,'become negative (value ',
+ 'is',F8.1,')after subtracting the scanner adc',/,1X,'offset',
+ ' (value currently',I6,/,1X,'Reset the scanner offset using',
+ ' keyword ADCOFFSET followed by value')
END IF
C---- Test that it has not rejected an unacceptable number of
C background points. This is set in INTEG2 to ensure at least
C NBGMIN (set using keywords REJECTION MINBG) background pixels left,
C and if not, flagged with ASPOT(1)=-9999. No data are available for
C these reflections asthe background plane is not calculated.
IF (ABS(ASPOT(1)+9999.0).LT.0.1) THEN
CAL* LDUMP = .TRUE.
NBADBG = NBADBG + 1
ISDG(IRECG) = -9999
LBADBG = .TRUE.
C
C If doing a separate pass to update sigmas based on calculated ERRINST,
C flag these reflections so they can be printed as badspots.
IF (.NOT.ERRSET) ISDG(IRECG) = -8888
ISDPRO(IRECG) = -9999
ISIGPRO = -9999
ISPOT = 0
ISDBSI = 0
BGRATIO = 0.0
PKRATIOS = 0.0
A = 0.0
B = 0.0
C = 0.0
GOTO 725
ELSE
LBADBG = .FALSE.
END IF
C
C---- Set PEAKVAR to zero for partials (it may be very large for partials
C ie gt 32767 and then can't store it in ISDG
C
IF (.NOT.FULL) PEAKVAR = 0.0
C
IF (FULL.AND.(.NOT.(OVRLFIT.OR.EDGEFIT)).AND.(SOD.GT.100.)) THEN
C
C---- Add box shift to delx,dely
C
DELX = (DELX+IXSHIFT)/FACT
DELY = (DELY+IYSHIFT)/FACT
XCGSP(NPBOX) = XCGSP(NPBOX) + DELX*DELX
YCGSP(NPBOX) = YCGSP(NPBOX) + DELY*DELY
XWCGSP(NPBOX) = XWCGSP(NPBOX) + DELX*DELX*SOD
YWCGSP(NPBOX) = YWCGSP(NPBOX) + DELY*DELY*SOD
WCGSP(NPBOX) = WCGSP(NPBOX) + SOD
NCGSP(NPBOX) = NCGSP(NPBOX) + 1
ELSE
DELX = 0.0
DELY = 0.0
END IF
C
C---- NREJ is the number of ADDITIONAL background points rejected (ie not
C including those masked out by overlapping spots
C
NREJ = NINT(ASPOT(15))
SUMREJ = SUMREJ + NREJ
NREJSUM = NREJSUM + 1
SUMBG = SUMBG + TBGND
C
C---- Must update number of background points to allow for rejected
C pixels.
C
TBGND = TBGND - NREJ
C
C---- Calculate standard deviation of intensity
C
VSPOT = GAIN*SOD
C
C---- Next two lines corrected 8/1/86
C vbg=tpeak*rmsbg
C vbg=vbg*vbg/tbgnd
C
VBG = TPEAK*RMSBG*RMSBG
C
C
IF ((VBG.LT.0.0) .OR. (PEAKVAR.LT.0.0)) THEN
WRITE (IOUT,FMT=6106) VBG,VSPOT,PEAKVAR,NPBOX,NREJ,FULL,
+ IPART,DELX,DELY,ASPOT(1),ASPOT(13)
6106 FORMAT (1X,'**** SERIOUS ERROR, CONSULT PROGRAMMER ***',/1X,'***',
+ '** VBG=',E12.5,' VSPOT=',E12.5,' PEAKVAR=',E12.5,
+ /,1X,'NPBOX=',I3,' NBKREJ=',I3,' FULL ',L1,' IPART',I3,
+ ' DELX,Y',2F6.2,/,1X,' SOD',F8.1,' PROF I',F8.1)
IF (ONLINE) WRITE (ITOUT,FMT=6106) VBG,VSPOT,PEAKVAR,NPBOX,
+ NREJ,FULL,
+ IPART,DELX,DELY,ASPOT(1),ASPOT(13)
IF (PEAKVAR.LT.0.0) PEAKVAR = 0.0
IF (VBG.LT.0.0) VBG = 0.0
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
END IF
C
C---- This sigma does not include instrument error correction
C (added later) unless the detector error factor has been set explicitly
C
C *** Change this to counting statistics based value
C ISDBSI = SQRT(2*VBG+ABS(VSPOT))*SCAI + 0.5
C
C---- For sigma calculations, use ABS(integrated intensity) to avoid getting
C anomalously low sigmas for very -ve reflections
C
ABSSOD = ABS(SOD)
XX = (ABSSOD/BOXFAC)**2*TPEAK
IF (ERRSET) THEN
AX = 1.0
IF (TBGND.NE.0.0)
+ AX = GAIN*(ABSSOD+BGND+BGND*TPEAK/TBGND) + ERRINST*XX
IF (AX.LT.0.0) THEN
WRITE(IOUT,6107) AX,ABSSOD,BGND,TPEAK,TBGND,XX,ERRINST,NREJ,
+ NBREJ,ASPOT
IF (ONLINE) WRITE(ITOUT,6107) AX,ABSSOD,BGND,TPEAK,TBGND,XX,
+ ERRINST,NREJ,NBREJ,ASPOT
6107 FORMAT(//,1X,'****** SERIOUS ERROR *****',/1X,'-VE VAR',
+ 'IANCE',/,1X,'AX ABSSOD BGND TPEAK',4E12.3,/,1X,
+ ' TBGND,XX ERRINST',2E12.3,E10.2,/,1X,'NREJ,NBREJ',2I6,
+ /,1X,'ASPOT ',6E12.3/,1X,6E12.3,/,1X,6E12.3)
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
AX = 1.0
END IF
ISDBSI=SCAI*SQRT(AX) + 0.5
ELSE
AX = 1.0
IF (TBGND.NE.0.0) AX = GAIN*(ABSSOD+BGND+BGND*TPEAK/TBGND)
IF (AX.LT.0.0) THEN
WRITE(IOUT,6107) AX,ABSSOD,BGND,TPEAK,TBGND,XX,ERRINST,NREJ,
+ NBREJ
IF (ONLINE) WRITE(ITOUT,6107) AX,ABSSOD,BGND,TPEAK,TBGND,XX,
+ ERRINST,NREJ,NBREJ
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
AX = 1.0
END IF
ISDBSI=SCAI*SQRT(AX) + 0.5
END IF
ISDBSI = MAX(ISDBSI,1)
C
C---- Check magnitude of ISDBSI and PEAKVAR to avoid I*2 overflow
C
IF (ISDBSI.GT.32767) THEN
C
C
C---- This now only happens for very intense spots, where the
C scanner factor makes the estimated sigma too large, so
C just reset it.
ISDBSI = 32700
C---- If this is a profile fitted overload, just reset ISDBSI to
C 32000
CAL IF (OVRLFIT) THEN
CAL ISDBSI = 32000
CAL ELSE
CAL CALL GETHKL(IRECG,IH)
CAL WRITE (IOUT,FMT=6108) ISDBSI,(IH(K),K=1,3)
CAL IF (ONLINE) WRITE (ITOUT,FMT=6108) ISDBSI,(IH(K),K=1,3)
6108 FORMAT(/,/,1X,'Error 6108 in subroutine process',/,
$ 1X,'**** SERIOUS ERROR ****',/,1X,' The standard ',
+ 'deviation of the integrated intensity is',I10,/,1X,
+ 'which is greater than the maximum allowed value (32767)',
+ 'Something may be seriously wrong',/,1X,'h,k,l',3I4,/,1X,
+ 'The pixel values for this spot follow',/)
CAL MAXPIX = 0
CAL CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
CAL IF (ERRSET) THEN
CAL WRITE(IOUT,FMT=6109) EFAC
CAL IF (ONLINE) WRITE(ITOUT,FMT=6109) EFAC
6109 FORMAT(/,1X,'Error 6109 in subroutine process',/,1X,
$ 'The value of the detector error factor used ',
+ 'in the calculation of the',/,1X,'standard deviation ',
+ 'is',F12.3,'.. is this correct ?',/,1X,'Usually this ',
+ 'error can be avoided by assigning a small value to',/,1X,
+ 'the detector error factor (keyword DETECTOR): DETECTOR 0.1')
CAL END IF
CAL END IF
END IF
C
CAL
IF (SQRT(PEAKVAR).GT.32767) THEN
C
C---- Reset PEAKVAR to 32000**2 so it doesn't cause integer overflow
C problems. These reflections will have the profile fitted measurement
C rejected anway because PKRATIO will be very high.
PEAKVAR = 32000.0*32000.0
END IF
IF ((ASPOT(16).LE.0.0).OR.BADSPOT) THEN
BADPROF = .TRUE.
ASPOT(16) = 10000000.0
CALL GETHKL(IRECG,IH)
WRITE (IOUT,FMT=6113)
IF (ONLINE) WRITE (ITOUT,FMT=6113)
6113 FORMAT(1X,'Very poor profile fit for this spot.',
+ ' The pixel values follow',/)
CAL 6113 FORMAT(//1X,'**** SERIOUS ERROR ****',/,1X,' The ',
CAL + 'fit of the scaled profile to this reflection is',/,1X,
CAL + 'very poor. Something may be seriously wrong',/,1X,
CAL + 'Does the reflection profile (printed below) look ',
CAL + ' flat-topped ?',/,1X,'If so, you may need to reduce',
CAL + ' the value of CUTOFF',
CAL + ' (currently',I7,')',/,1X,'which defines the saturation',
CAL + ' point of the detector',/,1X,'Use keywords ',
CAL + 'OVERLOAD CUTOFF to do this',/,1X,
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
CALL GETHKL(IRECG,IH)
C
C---- Allow for switch inversion right to left of Mar images
C
IXP = IXPIX
IF (INVERTX) IXP = NREC - IXPIX + 1
IF (TBGND.GT.0) X1 = GAIN*(ABSSOD+BGND+BGND*TPEAK/TBGND)
X2 = ERRINST*XX
C
IF (ONLINE) WRITE(ITOUT,FMT=7150)I,(IH(K),K=1,3),
+ IXP,IYPIX,NPBOX,NXX,NYY,
+ RMSBG,DELX,DELY,NREJ+NBREJ,A,B,C,BGDEVMAX,
+ TBGND,TPEAK,BOXFAC,X1,X2
WRITE(IOUT,FMT=7150)I,(IH(K),K=1,3),
+ IXP,IYPIX,NPBOX,NXX,NYY,RMSBG,
+ DELX,DELY,NREJ+NBREJ,A,B,C,BGDEVMAX,
+ TBGND,TPEAK,BOXFAC,X1,X2
IF (ONLINE) WRITE(ITOUT,FMT=7162) ISPOT,ISDBSI,ISPOTPRO,
+ ISIGPRO,VBG,VSPOT,PEAKVAR,FULL
WRITE(IOUT,FMT=7162) ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,VBG,VSPOT,
+ PEAKVAR,FULL
C
IF (VARPRO) THEN
WRITE(IOUT,7163)(IPRNUM(J),J=1,4),(WTPR(J),J=1,4),
+ LMASKREJ(1),MASKREJP(1,NPBOX),
+ MASKREJO(1),LMASKREJP(1),SUMPQ(5,NY)
IF (ONLINE) WRITE(ITOUT,7163) (IPRNUM(J),J=1,4),
+ (WTPR(J),J=1,4),LMASKREJ(1),MASKREJP(1,NPBOX),
+ MASKREJO(1),LMASKREJP(1),SUMPQ(5,NY)
C ****************************************************
CALL PLOTPROF(OD,IPROFL(1,IWTBOX),LRAS,
+ LMASK,PROFSUMS(1,IWTBOX),WPROFSUMS(1,IWTBOX),
+ MASKREJO,MASKREJP(1,NPBOX),LMASKREJP,WEIGHT,
+ PKONLY)
C ****************************************************
ELSE
C ****************************************************
CALL PLOTPROF(OD,IPROFL(1,NPBOX),LRAS,
+ MASK(1,NY),PROFSUMS(1,NPBOX),WPROFSUMS(1,NPBOX),
+ MASKREJO,MASKREJP(1,NPBOX),LMASKREJP,WEIGHT,
+ PKONLY)
C ****************************************************
C
END IF
END IF
C
C---- Sums for instrument error correction
C
IF (FULL.AND.(.NOT.(OVRLFIT.OR.EDGEFIT))) THEN
C
C---- Need to trap outliers ??
C Eliminate reflections with PKRATIO > 6
C
C *** Change to counting statistics ***
C PKRATIOS = SQRT(PEAKVAR/(QFAC*BGND + ABS(VSPOT)))
PKRATIOS = 0.0
AX = ABSSOD +BGND
IF (AX.NE.0.0) PKRATIOS=SQRT(PEAKVAR/(GAIN*AX))
C
C
IF (PKRATIOS.GT.6.0) THEN
NSUMR = NSUMR + 1
PKREJS = PKREJS + PKRATIOS
ELSE
C *** Change to counting statistics ***
C ASUM = (PEAKVAR - (QFAC*BGND + ABS(VSPOT))) + ASUM
ASUM=ASUM+(PEAKVAR-(ABSSOD+BGND)*GAIN)
BSUM = XX + BSUM
END IF
C
C If detector error factor already set, calculate true PKRATIO now
IF (ERRSET) THEN
PKRATIOS = 0.0
AX = GAIN*(ABSSOD+BGND)+ERRINST*XX
IF (AX.NE.0.0) PKRATIOS=SQRT(PEAKVAR/AX)
END IF
ELSE
C
C Partial or fitted overload
PKRATIOS = 0.0
END IF
C
C---- Use BADPROF flag to set rejection of spots (full or partial)
C with very poor profile fit such that ASPOT(16) is negative
IF (BADPROF) THEN
PKRATIOS = 99.0
END IF
C
C---- Store variables for recalculating sigmas and PKRATIO in second pass
C using calculated ERRINST.
IF (.NOT.ERRSET) THEN
NPEAK(I) = TPEAK
RMSBGX(I) = RMSBG
BGNDX(I) = BGND
ISDG(IRECG) = SQRT(PEAKVAR)*SCAI + 0.5
C
C---- Store background plane constants (to be printed for badspots) as
C integers packed into IABC. Gradients restricted to range +-45
IA = MAX(0,MIN(NINT(A+45),99))
IB = MAX(0,MIN(NINT(B+45),99))
IC = MIN(NINT(C),9999)
IABC(I) = IA + IB*100 + IC*10000
END IF
C
C---- Calculate profile sigma for fulls on basis of background
C variation plus fit of ods to the profile.
C For partials, profile fitted overloads and profile fitted edge
C reflections, use the integrated sigmas.
C Note correction to Rossmann formula involving the profile factor.
IF (FULL.AND.(.NOT.(OVRLFIT.OR.EDGEFIT))) THEN
C Change to counting statistics
C ISIGPRO = SQRT(PROFACT(NPBOX)*PEAKVAR + VBG) * SCAI + 0.5
IF (WEIGHT) THEN
IF (PKONLY) THEN
ISIGPRO = SQRT(PROFACT(NPBOX)*PEAKVAR+VBG)*SCAI + 0.5
ELSE
ISIGPRO = SCAI*SQRT(ASPOT(16))
END IF
ELSE
ISIGPRO = -9999
IF (TBGND.NE.0.0)
+ ISIGPRO = SCAI*SQRT(GAIN*BGND*TPEAK/TBGND +
+ PROFACT(NPBOX)*PEAKVAR) + 0.5
END IF
IF (ISIGPRO.EQ.0) ISIGPRO = 1
ELSE
ISIGPRO = ISDBSI
END IF
C
C---- Check ISIGPRO le 32767
C
IF (ISIGPRO.GT.32767) THEN
CALL GETHKL(IRECG,IH)
C
C---- Allow for switch inversion right to left of Mar images
C
IXP = IXPIX
IF (INVERTX) IXP = NREC - IXPIX + 1
WRITE (IOUT,FMT=6115) CUTOFF,IXP,IYPIX,NPBOX,
+ (IH(K),K=1,3)
IF (ONLINE) WRITE (ITOUT,FMT=6115) CUTOFF,
+ IXP,IYPIX,NPBOX,(IH(K),K=1,3)
6115 FORMAT(//1X,'**** SERIOUS ERROR ****',/,1X,' The ',
+ 'fit of the scaled profile to this reflection is',/,1X,
+ 'very poor. Something may be seriously wrong',/,1X,
+ 'Does the reflection profile (printed below) look ',
+ ' flat-topped ?',/,1X,'If so, you may need to reduce',
+ ' the value of CUTOFF',
+ ' (currently',I8,')',/,1X,'which defines the saturation',
+ ' point of the detector',/,1X,'Use keywords ',
+ 'OVERLOAD CUTOFF to do this eg OVERLOAD CUTOFF 110000',/,1X,
+ 'Pixel coordinates are IX=',I5,' IY=',I5,
+ ' Profile box number',I3,/,1X,'h,k,l',3I4,/,1X,
+ 'The pixel values for this spot follow')
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
ISIGPRO = 32760
END IF
C
C
C---- If detector error not set, flag fitted overloads so that the profile
C fitted sigma will be set to the updated (allowing for instrument
C error) value of the summation sigma on the second pass through
C the reflection list (800 loop)
C
IF ((OVRLFIT.OR.EDGEFIT).AND.(.NOT.ERRSET)) ISIGPRO = 7777
C
C---- Flag reflections where the profiles were rejected
C
IF (NOPROFILE(NPBOX)) THEN
ISPOTPRO = ISPOT
C
C---- flag this reflection so that sigma is updated for instrument error
C if not ERRSET.
C
IF (ERRSET) THEN
ISIGPRO = ISDBSI
ELSE
ISIGPRO = 7777
END IF
END IF
C
C---- Store intensities
C
ISPOT = SCAI*SOD + 0.5
ISPOTPRO = SCAI*SODPRO + 0.5
C
INTG(IRECG) = ISPOT
C
C---- Allow for outputting non-background corrected integrated intensities
C
IF (NOBACK) THEN
ISPOT = SCAI*(SOD+ASPOT(2)) + 0.5
INTG(IRECG) = ISPOT
ISDBSI = SQRT(GAIN*ISPOT + ERRINST*XX) + 0.5
END IF
C
C Note that if .NOT. ERRSET, ISDG is used to store PEAKVAR, so
C only assign a correct value if the detector error has been set.
IF (ERRSET) ISDG(IRECG) = ISDBSI
IPRO(IRECG) = ISPOTPRO
ISDPRO(IRECG) = ISIGPRO
C
C---- Fraction of background points rejected for this spot
C
IF (SUMPQ(6,NY).NE.0) BGRFRC = (SUMPQ(6,NY)-TBGND)/SUMPQ(6,NY)
C
IF ((DUMP(1) .AND.
+ ((I/NDUMP)*NDUMP.EQ.I .AND. ISPOT.GT.IDUMP
+ .AND. JDUMP.LE.MXDUMP)).OR.
+ (FULL .AND. (ISPOT.GT.IPLOT) .AND. (IPLOT.GT.0)).OR.
+ (DUMP(4).AND.(BGRFRC.GT.BGRLIM).AND.(JDUMP.LE.MXDUMP)) .OR.
+ (DUMP(5).AND.OVRLFIT.AND.(JDUMP.LE.MXDUMP)) .OR.
+ (DUMP(5).AND.EDGEFIT.AND.(JDUMP.LE.MXDUMP)) .OR.
+ (DUMP(10).AND.(LMASKREJP(1).GT.NDEBUG(80))).OR.
+ (LDUMP)) THEN
C
C---- Check for dumping only fully recorded reflections
C
IF (DUMP(9).AND.(.NOT.FULL)) GOTO 708
C
C---- Check intensity
C
IF ((ISPOTPRO.LT.IDMIN).OR.(ISPOTPRO.GT.IDMAX)) GOTO 708
C
JDUMP = JDUMP + 1
CALL GETHKL(IRECG,IH)
C
C---- Allow for switch inversion right to left of Mar images
C
IXP = IXPIX
IF (INVERTX) IXP = NREC - IXPIX + 1
IF (TBGND.GT.0.) X1 = GAIN*(ABSSOD+BGND+BGND*TPEAK/TBGND)
X2 = ERRINST*XX
IF (VARPRO) THEN
PSCALE = ASPOT(13)/PROFSUMS(3,IWTBOX)
IF (WEIGHT) PSCALE = ASPOT(13)/WPROFSUMS(3,IWTBOX)
IF (PKONLY) PSCALE = ASPOT(13)/PROFSUMS(3,IWTBOX)
ELSE
PSCALE = ASPOT(13)/PROFSUMS(3,NPBOX)
IF (WEIGHT) PSCALE = ASPOT(13)/WPROFSUMS(3,NPBOX)
IF (PKONLY) PSCALE = ASPOT(13)/PROFSUMS(3,NPBOX)
END IF
IF (ONLINE) WRITE(ITOUT,FMT=7150)I,(IH(K),K=1,3),
+ IXP,IYPIX,NPBOX,NXX,NYY,
+ RMSBG,DELX,DELY,NREJ+NBREJ,A,B,C,BGDEVMAX,TBGND,TPEAK,
+ BOXFAC,X1,X2,PSCALE*PRGRAD(NPBOX)
7150 FORMAT(///1X,'Dumping reflection',I5,' Indices',3I4,
+ ' pixel coordinates', 2I6,
+ /1X,'NPBOX=',I3,' NXX,NYY',2I3,' RMSBG=',F6.0,
+ ' DELX,DELY',2F5.1,' NREJTOT',I4,/1X,' A,B,C',2F8.2,F9.1,
+ ' BGDEVMAX',F6.1,' TBGND',F6.0,' TPEAK',F6.0,/,1X,
+ 'Box factor ',F6.3,' Counting statistics variance',F12.0,
+ ' detector error variance',F12.0,' Scaled profile gradient',
+ F10.2)
WRITE(IOUT,FMT=7150)I,(IH(K),K=1,3),
+ IXP,IYPIX,NPBOX,NXX,NYY,RMSBG,DELX,
+ DELY,NREJ+NBREJ,A,B,C,BGDEVMAX,TBGND,TPEAK,
+ BOXFAC,X1,X2,PSCALE*PRGRAD(NPBOX)
IF (ONLINE) WRITE(ITOUT,FMT=7162) ISPOT,ISDBSI,ISPOTPRO,
+ ISIGPRO,VBG,VSPOT,PEAKVAR,FULL,IPART,PSCALE
7162 FORMAT(1X,'ISPOT=',I10,' ISDSBI=',I6,' ISPOTPRO=',I10,
+ ' ISIGPRO='
+ ,I6,/,' VBG=',F10.0,' VSPOT=',F10.0,' PEAKVAR=',F14.0,
+ ' FULL=',L1,' IPART=',I4,/,1X,
+ 'Profile scale factor',F9.3)
WRITE(IOUT,FMT=7162) ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,VBG,VSPOT,
+ PEAKVAR,FULL,IPART,PSCALE
C
IF (VARPRO) THEN
WRITE(IOUT,7163)(IPRNUM(J),J=1,4),(WTPR(J),J=1,4),
+ LMASKREJ(1),MASKREJP(1,NPBOX),
+ MASKREJO(1),LMASKREJP(1),SUMPQ(5,NY)
IF (ONLINE) WRITE(ITOUT,7163) (IPRNUM(J),J=1,4),
+ (WTPR(J),J=1,4),LMASKREJ(1),MASKREJP(1,NPBOX),
+ MASKREJO(1),LMASKREJP(1),SUMPQ(5,NY)
7163 FORMAT(1X,'Profiles used in variable profile',4I4,/,1X,
+ 'Weights:',4F6.2,/,1X,'Number of background',
+ ' pixels rejected as overlapped',I4,' Number ',
+ 'of peak pixels rejected as overlapped',I3,
+ /,1X,'Number background pixels rejected as ',
+ 'outliers',I3,
+ ' Number pixels rejected due to poor profile',
+ ' fit',I3,/,1X,'Number of peak pixels',F4.0)
C ****************************************************
CALL PLOTPROF(OD,IPROFL(1,IWTBOX),LRAS,
+ LMASK,PROFSUMS(1,IWTBOX),WPROFSUMS(1,IWTBOX),
+ MASKREJO,MASKREJP(1,NPBOX),LMASKREJP,WEIGHT,
+ PKONLY)
C ****************************************************
ELSE
C ****************************************************
CALL PLOTPROF(OD,IPROFL(1,NPBOX),LRAS,
+ MASK(1,NY),PROFSUMS(1,NPBOX),WPROFSUMS(1,NPBOX),
+ MASKREJO,MASKREJP(1,NPBOX),LMASKREJP,WEIGHT,
+ PKONLY)
C ****************************************************
C
END IF
END IF
C
C
708 IF (BGND.GT.0.0) GO TO 710
NWRN = NWRN + 1
WRITE (IOUT,FMT=6110) IXPIX,IYPIX
6110 FORMAT (' ZERO Background spot, X,Y ',2I5)
IF (ONLINE) WRITE (ITOUT,FMT=6110) IXPIX,IYPIX
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
BGND = 0.01
NBZERO = NBZERO + 1
C
C *** Change to counting statistics ***
C 710 BGRATIO = RMSBG/SQRT(QFAC*BGND/TPEAK)
710 IF (BGND.NE.0.0) BGRATIO=RMSBG/SQRT(GAIN*BGND/TPEAK)
C
C---- Compile statistics if ERRSET to avoid another loop over
C reflections
C
IF (ERRSET) THEN
C
C---- Modify IPART if adding partials (ADDPART). If IR=5 this is a
C partial over 3 images and this is the first, so IPART is correct.
C If IR=6, this is a partial over 3 images and this is the summed
C contribution from images 2 and 3, and cannot be used in analysis
C because we don't know its degree of partiality
C
IF (ADDPART) THEN
IF (IR.LT.5) THEN
IPART = 0
ELSE IF (IR.EQ.6) THEN
IPART = -999
END IF
END IF
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
CALL STATS(ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS,NPBOX,IPART,FULL,OVRLFIT,
+ ITHBIN)
END IF
C
C
IF ((.NOT.FULL).OR.(OVRLFIT.OR.EDGEFIT)) GO TO 720
XX = IXPIX/FACT
YY = IYPIX/FACT
C
C---- May not yer have requested plot after integration, can be activated
C as a result of wanting to see bad spots
C
C** IF (PLRESID) THEN
ITXVECT(NRESID*5+1) = IXPIX
ITXVECT(NRESID*5+2) = IYPIX
ITXVECT(NRESID*5+3) = NINT(DELX)
ITXVECT(NRESID*5+4) = NINT(DELY)
ITXVECT(NRESID*5+5) = MIN(ISPOT/100,32767)
NRESID = NRESID + 1
C** END IF
C
IF (ISPOT.LT.IRANGE(3)) GO TO 720
C
C
IXX = XX - XCEN
IYY = YY - YCEN
C
C ****************************************
CALL XYSHIFT(DELX,DELY,IXX,IYY,XSH,YSH,NSH,1)
C ****************************************
C
720 MAXBSI = MAX(MAXBSI,ISPOTPRO)
MINBSI = MIN(MINBSI,ISPOTPRO)
C
C---- Background point rejection histogram
C
NNREJ = NREJ + NBREJ
II = (NNREJ-1)/5 +2
IF (NNREJ.EQ.0) II = 1
IF (II.GT.31) II = 32
NBGRHIST(II) = NBGRHIST(II) + 1
C
C---- Check for BADSPOTS only if using input error factor
C
725 IF (ERRSET) THEN
C
C Test gradient/(average background), flag if more than GRADMAX
C
IF (C.GT.0.0) THEN
GRADBAD = ((A/C.GT.GRADMAX).OR.(B/C.GT.GRADMAX))
ELSE
GRADBAD = .FALSE.
END IF
C
C
IF ((BGRATIO.GT.BGRAT) .OR. (ISPOTPRO.LT.-5*ISIGPRO) .OR.
+ (PKRATIOS.GT.PKRAT) .OR. (GRADBAD) .OR.
+ LDUMP) THEN
C
NBAD = NBAD + 1
IBAD = 0
IF (BGRATIO.GT.BGRAT) IBAD = IBAD + 1
IF (PKRATIOS.GT.PKRAT) IBAD = IBAD + 2
IF (ISPOTPRO.LT.-5*ISIGPRO) IBAD = 4
IF (GRADBAD) IBAD = 8
IF (IBAD.EQ.0) IBAD = 16
IF (LBADBG) THEN
IBAD = 17
LBADBG = .FALSE.
END IF
C
C---- Store "bad" flag in IGFLAG
C
IF (IBAD.NE.16) IGFLAG(IRECG) = -IBAD
C
C---- If online, write badspots to unit 46 for inspection later
C
IF (ONLINE) THEN
WRITE (46) KREC,ISPOTPRO,ISIGPRO,JBGND,RMSBG,BGRATIO,
+ PKRATIOS,NXY,NXX,NYY,A,B,C,IBAD
WRITE (46) (OD(II),II=1,NXY)
IF (DEBUG(18)) WRITE (ITOUT,FMT=6118) KREC,ISPOTPRO,
+ ISIGPRO,JBGND,RMSBG,BGRATIO,PKRATIOS,NXY,NXX,NYY
END IF
C
C---- If running in batch mode, flag bad spots as rejected
C
C
IF (NBAD.EQ.1) THEN
IF (ONLINE ) WRITE (ITOUT,FMT=6132)
WRITE (IOUT,FMT=6132)
6132 FORMAT (/1X,'List of BADSPOTS',/,1X,'INT and SD'
+ ,' are the profile fitted intensity and sigma.',/,1X,
+ 'A,B,C are the background plane constants. M/100 is',
+ ' the degree of partiality',/,1X,'(M=0 for fully ',
+ 'recorded). XS, YS are scanner coordinates in pixels',
+ ' wrt origin',/,1X,'at the first pixel in the image.')
IF (PKACCEPT) THEN
WRITE(IOUT,6143)
IF (ONLINE) WRITE(ITOUT,6143)
ELSE
WRITE(IOUT,6131)
IF (ONLINE) WRITE(ITOUT,6131)
END IF
6131 FORMAT(1X,'Reflections failing PKRATIO test will',
+ ' be rejected')
6143 FORMAT(1X,'For reflections failing the PKRATIO test,',
+ ' the profile fitted I and sigma will be set',
+ ' to the summation integration values')
IF ((BADPLOT).OR.(BADPLOT2)) THEN
WRITE(IOUT,6133)
IF (ONLINE) WRITE(ITOUT,6133)
END IF
WRITE (IOUT,FMT=6130)
IF (ONLINE) WRITE (ITOUT,FMT=6130)
6130 FORMAT (' H K L M XG YG XS YS ',
+ ' INT SD BGRATIO PKRATIO PLANE A B C')
6172 FORMAT (' H K L M XG YG XS YS ',
+ ' INT SD BGRATIO PKRATIO')
6174 FORMAT(1X,'Background plane constants',3F7.1,1X,A)
6133 FORMAT(1X,'The pixel values for each badspot will be ',
+ 'printed, with scanner X axis across the page ',/
+ ,1X,'and scanner Y up the page, origin in lower ',
+ 'left corner')
END IF
C
C ****************
CALL GETHKL(IRECG,IH)
C ****************
C
XCG = XG(IRECG)
YCG = YG(IRECG)
CALL MMTOPX(XC,YC,XCG,YCG)
IXPIX = NINT(XC*FACT)
C
C---- Allow for switch inversion right to left of Mar images
C
IF (INVERTX) IXPIX = NREC - IXPIX + 1
IYPIX = NINT(YC*FACT)
WRITE (IOUT,FMT=6134) (IH(II),II=1,4),XG(IRECG),YG(IRECG),
+ IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,PKRATIOS,A,B,C,
+ BADSTR(IBAD)
IF (ONLINE) WRITE(ITOUT,FMT=6134)
+ (IH(II),II=1,4),XG(IRECG),YG(IRECG),
+ IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,PKRATIOS,A,B,C,
+ BADSTR(IBAD)
C
C---- Reject the profile fitted I under all circumstances
C ONLY set the rejection flag if running in batch mode, as when running
C ONLINE there is the opportunity of inspecting badspots.
C Do NOT flag spots that have just been flagged for dumping and pass
C all other tests (IBAD=16)
C
IF (.NOT.ONLINE) THEN
IF (IBAD.NE.16) THEN
C** ISDPRO(IRECG) = -9999
C
C---- Do not reject the summation integration value if failure is only on
C PKRATIO, unless PKREJECT flag set, in which case, do reject it.
C
C** IF ((BGRATIO.GT.BGRAT) .OR. (ISPOTPRO.LT.-5*ISIGPRO)
C** + .OR.(GRADBAD).OR. ((PKRATIOS.GT.PKRAT).AND.PKREJECT))
C** + ISDG(IRECG) = -9999
END IF
END IF
C
IF (BADPLOT) THEN
WRITE(IOUT,FMT=6135)
IF (ONLINE) WRITE(ITOUT,FMT=6135)
6135 FORMAT(1X,'Pixel values for this spot')
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
WRITE(IOUT,6137)
IF (ONLINE) WRITE(ITOUT,6137)
6137 FORMAT(//)
WRITE(IOUT,6130)
IF (ONLINE) WRITE(ITOUT,6130)
END IF
IF (BADPLOT2) THEN
IF (VARPRO) THEN
WRITE(IOUT,7163)(IPRNUM(J),J=1,4),(WTPR(J),J=1,4),
+ LMASKREJ(1),MASKREJP(1,NPBOX),
+ MASKREJO(1),LMASKREJP(1),SUMPQ(5,NY)
IF (ONLINE) WRITE(ITOUT,7163) (IPRNUM(J),J=1,4),
+ (WTPR(J),J=1,4),LMASKREJ(1),MASKREJP(1,NPBOX),
+ MASKREJO(1),LMASKREJP(1),SUMPQ(5,NY)
C ****************************************************
CALL PLOTPROF(OD,IPROFL(1,IWTBOX),LRAS,
+ LMASK,PROFSUMS(1,IWTBOX),WPROFSUMS(1,IWTBOX),
+ MASKREJO,MASKREJP(1,NPBOX),LMASKREJP,WEIGHT,
+ PKONLY)
C ****************************************************
ELSE
C ****************************************************
CALL PLOTPROF(OD,IPROFL(1,NPBOX),LRAS,
+ MASK(1,NY),PROFSUMS(1,NPBOX),WPROFSUMS(1,NPBOX),
+ MASKREJO,MASKREJP(1,NPBOX),LMASKREJP,WEIGHT,
+ PKONLY)
C ****************************************************
C
END IF
END IF
END IF
END IF
C
C
GO TO 770
C
C---- Rejected spots (overloads, off edge of film)
C
730 NBOX = NBOX + 1
GO TO 760
C
C---- Summed partials with only one half
C
738 NHALF = NHALF + 1
INTG(IRECG) = -9999
ISDG(IRECG) = -9999
IPRO(IRECG) = -9999
ISDPRO(IRECG) = -9999
IGFLAG(IRECG) = -64
GO TO 770
740 NEDGE = NEDGE + 1
INTG(IRECG) = -9999
ISDG(IRECG) = -9999
IPRO(IRECG) = -9999
ISDPRO(IRECG) = -9999
IGFLAG(IRECG) = -64
GO TO 770
750 NOLO = NOLO + 1
760 INTG(IRECG) = IOVER
ISDG(IRECG) = -9999
IPRO(IRECG) = IOVER
ISDPRO(IRECG) = -9999
ISIGPRO = -9999
IGFLAG(IRECG) = -32
C ********************************************************************
C ********************************************************************
C
C---- End of loop over reflections
C
C ********************************************************************
C ********************************************************************
770 IF (LDUMP) THEN
DO 773 K = 1,80
NDEBUG(K) = NDEBUGS(K)
DEBUG(K) = SDEBUG(K)
773 CONTINUE
LDUMP = .FALSE.
END IF
772 CONTINUE
C
C---- Calculate the rms c. of g. shift (unweighted and weighted by intensity)
C
DO 780 JBOX = 1,NUMBOX
NRFP = NCGSP(JBOX)
IF (NRFP.GT.0) THEN
XCGRMS = SQRT(XCGSP(JBOX)/NRFP)
YCGRMS = SQRT(YCGSP(JBOX)/NRFP)
XWCGRMS = SQRT(XWCGSP(JBOX)/(NRFP*WCGSP(JBOX)))
YWCGRMS = SQRT(YWCGSP(JBOX)/(NRFP*WCGSP(JBOX)))
ELSE
XCGRMS = 0.0
YCGRMS = 0.0
END IF
IF (DEBUG(18)) THEN
WRITE(IOUT,FMT=6111) JBOX,NRFP,XCGRMS,YCGRMS,
+ XWCGRMS,YWCGRMS
IF (ONLINE) WRITE(ITOUT,FMT=6111) JBOX,NRFP,
+ XCGRMS,YCGRMS,XWCGRMS,YWCGRMS
6111 FORMAT(/,1X,'Box number, nrefls, unweighted and weighted',
+ ' (by intensity) rms DELX, DELY',/,1X,2I6,4F8.1)
END IF
780 CONTINUE
C
C---- Calculate mean number of rejected background pixels as a fraction
C of the mean number of background points, and compare with fraction
C expected from a normal distribution.
C
IF (NREJSUM.GT.0) THEN
SUMREJ = SUMREJ/REAL(NREJSUM)
SUMBG = SUMBG/REAL(NREJSUM)
IF (BGSIG.LE.0.3) THEN
FRAC =0.80
ELSE IF (BGSIG.LE.0.5) THEN
FRAC = 0.62
ELSE IF (BGSIG.LE.0.7) THEN
FRAC = 0.48
ELSE IF (BGSIG.LE.1.0) THEN
FRAC = 0.32
ELSE IF (BGSIG.LE.2.0) THEN
FRAC = 0.045
ELSE IF (BGSIG.LE.3.0) THEN
FRAC = 0.0028
ELSE
FRAC = 0.002
END IF
WARN(17) = (WARN(17).OR.(SUMREJ.GT.FRAC*SUMBG))
END IF
C---- Calculate instrument error correction. Can only do this if there are
C some fully recorded reflections present. With a large mosaic spread
C (and using ADDPART) the LAST image, which cannot add partials from the
C next image, may have no fully recorded reflections. Trap this and set
C detector error to zero.
C
C
C---- If all fully recorded reflections have been rejected (as badspots)
C then BSUM will be zero. Trap this.
C
IF ((NOFR.GT.0).AND.(BSUM.GT.0.0)) THEN
ERRINST = ASUM/BSUM
C
C If the gain or Selwyn granularity has been overestimated, it is possible
C for the variance in the fit of the profile to a reflection to be
C smaller than that expected, calculated on the basis of the granularity or
C counting statistics ie the profiles will fit better than expected.
C This will result in an apparently negative detector error factor.
C Hence the need to check the sign of ERRINST. Also when processing very
C weak data, it can calculate as negative. Do NOT allow the scanner erro
C factor to go negative, set it to zero and print a warning.
C
X = SQRT(ABS(ERRINST))
IF (ERRINST.LT.0.0) X = -X
EFACSQ = X
ELSE
C
C---- No fully recorded reflections, set ERRINST to zero
C
ERRINST = 0.0
X = 10000.0
WRITE(IOUT,FMT=6150)
IF (ONLINE) WRITE(ITOUT,FMT=6150)
6150 FORMAT(1X,'**** WARNING ****',/,1X,'There are no fully ',
+ 'recorded non-rejected reflections so the detector error',
+ /,1X,'factor cannot be calculated')
END IF
C
C
IF (EFAC.LT.-900) THEN
C
C---- Use calculated value unless negative
C
IF (X.EQ.10000.0) THEN
WRITE(IOUT,FMT=6154)
IF (ONLINE) WRITE(ITOUT,FMT=6154)
6154 FORMAT(1X,'The detector error factor will be set to zero')
ELSE IF (X.GT.0.0) THEN
WRITE (IOUT,FMT=6112) X
6112 FORMAT (/1X,'Calculated detector error factor',F6.2)
IF (ONLINE) WRITE (ITOUT,FMT=6112) X
ELSE IF (X.LT.0.0) THEN
WRITE (IOUT,FMT=6152) X
6152 FORMAT (/1X,'detector error factor has been calculated as',F6.2,
+ /,1X,'Negative values are physically unreasonable, so it',
+ ' has been set to zero')
IF (ONLINE) WRITE (ITOUT,FMT=6152) X
ERRINST = 0.0
END IF
ELSE
C
C---- Use input value but print calculated value
C
IF (X.EQ.10000.0) THEN
WRITE(IOUT,FMT=6156) EFAC
IF (ONLINE) WRITE(ITOUT,FMT=6156) EFAC
6156 FORMAT(1X,'The input detector error factor of ',F5.2,' will ',
+ 'be used')
ELSE
WRITE (IOUT,FMT=6114) X,EFAC
6114 FORMAT (/1X,'Calculated detector error factor is ',F4.2,' but',
+ ' input value of ',F5.2,' will be used')
IF (ONLINE) WRITE (ITOUT,FMT=6114) X,EFAC
ERRINST = EFAC*EFAC
END IF
END IF
C
C
IF (NSUMR.NE.0) THEN
PKRATIOS = PKREJS/NSUMR
WRITE(IOUT,FMT=7166) NSUMR,PKRATIOS
IF (ONLINE) WRITE(ITOUT,FMT=7166) NSUMR,PKRATIOS
7166 FORMAT(1X,I5,' Reflections with a mean PKRATIO (uncorrected ',
+ 'for detector error) of ',F5.1,/,1X,'have been rejected as ',
+ 'outliers in the determination of the detector error')
END IF
C
C---- Using calculated value for ERRINST, recalculate sigmas and PKRATIO
C if required
C
IF (ERRSET) GOTO 805
C
C
DO 800 I = 1,NREF
C
IF (MOD(I,250).EQ.0.AND.WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
OVRLFIT = .FALSE.
KREC = IPNTR(I)/100
IPNT = ABS(IPNTR(I))
IRECG = IPNT/100
C
C---- Omit summed partials which have been subsequently flagged as
C spatial overlaps
C
IR = IRG(IRECG)
IF (IR.EQ.2) THEN
IF (DEBUG(18)) THEN
CALL GETHKL(IRECG,IH)
WRITE(IOUT,FMT=6030) (IH(K),K=1,3), IRECG
IF (ONLINE) WRITE(ITOUT,FMT=6030) (IH(K),K=1,3), IRECG
END IF
GOTO 800
END IF
C
C---- skip reflections not processed above because of MINT test.
C these are flagged by IGFLAG()=0
C
IF (IGFLAG(IRECG).EQ.0) GO TO 800
C
C
ISDBSI = ISDG(IRECG)
C
C---- Skip overloads(unles fitted with profiles), off edge
C
IF (ISDBSI.EQ.-9999) GO TO 800
C
C---- Reflections with too many background pixels rejected
IF (ISDBSI.EQ.-8888) THEN
LDUMP = .TRUE.
ISPOT = 0
ISDBSI = 0
BGRATIO = 0.0
PKRATIOS = 0.0
A = 0.0
B = 0.0
C = 0.0
GOTO 802
END IF
C
C---- Extract number required for sigma calculation
C
TPEAK = NPEAK(I)
C
C
IF (TPEAK.EQ.0.0) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6116) I,IRECG,ISDBSI,
+ IGFLAG(IRECG)
6116 FORMAT (/1X,'ZERO TPEAK, I,IRECG',2I6,' ISDBSI',I7,' IGFLAG',I6)
WRITE (IOUT,FMT=6116) I,IRECG,ISDBSI,IGFLAG(IRECG)
END IF
C
C
RMSBG = RMSBGX(I)
VBG = TPEAK*RMSBG*RMSBG
BGND = BGNDX(I)
JBGND = SCAI*BGND + 0.5
C *** change to counting statistics
C BGRATIO = RMSBG/SQRT(QFAC*BGND/TPEAK)
IF (BGND.NE.0.0) BGRATIO=RMSBG/SQRT(GAIN*BGND/TPEAK)
SOD = INTG(IRECG)/SCAI
PEAKVAR = (ISDBSI/SCAI)**2
NPBOX = MOD(IPNT,100)
FULL = (IPNTR(I).GT.0)
ISPOT = INTG(IRECG)
ISPOTPRO = IPRO(IRECG)
ISIGPRO = ISDPRO(IRECG)
CC
C
C---- Extract background plane constants
C
II = IABC(I)
IC = II/10000
IB = (II-10000*IC)/100
A = (II-10000*IC-100*IB) -45
B = IB -45
C = IC
ABSSOD = ABS(SOD)
XX = (ABSSOD/BOXFAC)**2*TPEAK
C
C
C---- If ERRINST calculates as negative (possible if
C granularity has been overestimated, see above)
C must trap -ve sqrt
C isdbsi = sqrt(2.0*vbg+qfac*sod+errinst*xx)*scai + 0.5
C
C *** change to counting statistics
C
C VARTOT = 2.0*VBG + QFAC*SOD + ERRINST*XX
IF (TBGND.NE.0) VARTOT=GAIN*(ABSSOD+BGND+BGND*TPEAK/TBGND)
1 + ERRINST*XX
IF (VARTOT.LE.0.0) VARTOT = 0
ISDBSI = SCAI*SQRT(VARTOT) + 0.5
ISDBSI = MAX(ISDBSI,1)
IF (ISDBSI.GT.32767) THEN
ISDBSI = 32700
CAL CALL GETHKL(IRECG,IH)
CAL WRITE (IOUT,FMT=6117) ISDBSI,(IH(K),K=1,3)
CAL IF (ONLINE) WRITE (ITOUT,FMT=6117) ISDBSI,(IH(K),K=1,3)
6117 FORMAT(//1X,'**** SERIOUS ERROR ****',/,1X,' The standard ',
+ 'deviation of the integrated intensity is',I10,/,1X,
+ 'which is greater than the maximum allowed value (32767)',
+ 'Something is seriously wrong',/,1X,'h,k,l',3I5)
CAL WRITE(IOUT,FMT=6109) SQRT(ERRINST)
CAL IF (ONLINE) WRITE(ITOUT,FMT=6109) SQRT(ERRINST)
CAL CALL SHUTDOWN
END IF
ISDG(IRECG) = ISDBSI
C
IPART = IMG(IRECG)
C---- For partials,reflections where profile was rejected, and
C profile fitted overloads, use summation integration sigma in
C place of profile fitted sigma. Set OVRLFIT so that fully recorded
C overloads or fitted edge reflections are not included in PKRATIOS
C statistics in call to STATS.
C
IF (.NOT.FULL .OR. ISIGPRO.EQ.7777) THEN
OVRLFIT = .TRUE.
ISIGPRO = ISDBSI
ISDPRO(IRECG) = ISIGPRO
END IF
C
C---- PKRATIO is ratio of sigma calculated from selwyn granularity
C to that calculated from fit of profile. Only applicable to
C full reflections.
C Calculate PKRATIO
C
IF (FULL) THEN
C
C---- If ERRINST calculates as negative (possible if
C granularity has been overestimated, see above)
C must trap -ve sqrt and divide by zero
C
C pkratios = sqrt(peakvar/ (qfac*bgnd+qfac*sod+errinst*xx))
C
C *** change to counting statistics
C VARTOT = QFAC*BGND + QFAC*SOD + ERRINST*XX
VARTOT = (GAIN*(BGND+ABSSOD)+ERRINST*XX)
IF (VARTOT.LE.1.0) VARTOT = 1.0
PKRATIOS = SQRT(PEAKVAR/VARTOT)
ELSE
PKRATIOS = 0.0
END IF
C
C
C---- Modify IPART if adding partials (ADDPART). If IR=5 this is a
C partial over 3 images and this is the first, so IPART is correct.
C If IR=6, this is a partial over 3 images and this is the summed
C contribution from images 2 and 3, and cannot be used in analysis
C because we don't know its degree of partiality
C
IF (ADDPART) THEN
IF (IR.LT.5) THEN
IPART = 0
ELSE IF (IR.EQ.6) THEN
IPART = -999
END IF
END IF
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
CALL STATS(ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS,NPBOX,IPART,FULL,OVRLFIT,ITHBIN)
C
IF (DUMPSPOT) THEN
C
C---- Compare indices with list in IHD, set LDUMP true if match found
C
C **************************
CALL COMPR(KREC,IHD,LDUMP,NHKLD)
C **************************
C
C---- Uncomment next 2 lines if full debugoutput required when scanner
C factor not initially assigned.
CAL IF (DUMPALL.AND.(I.GE.NDSTART).AND.((I-NDSTART).LE.NDTOT))
CAL + LDUMP = .TRUE.
END IF
C
C---- Test for badspots
C
C
C Test gradient/(average background), flag if more than GRADMAX
C
IF (C.GT.0.0) THEN
GRADBAD = ((A/C.GT.GRADMAX).OR.(B/C.GT.GRADMAX))
ELSE
GRADBAD = .FALSE.
END IF
C
802 IF ((BGRATIO.GT.BGRAT) .OR. (ISPOTPRO.LT.-5*ISIGPRO) .OR.
+ (PKRATIOS.GT.PKRAT) .OR. (GRADBAD) .OR.
+ LDUMP) THEN
C
C---- Write badspots to unit 46 if running online. Note we no longer
C have option of dumping pixel values
C
LDUMP = .FALSE.
C
NBAD = NBAD + 1
IBAD = 0
IF (BGRATIO.GT.BGRAT) IBAD = IBAD + 1
IF (PKRATIOS.GT.PKRAT) IBAD = IBAD + 2
IF (ISPOTPRO.LT.-5*ISIGPRO) IBAD = 4
IF (GRADBAD) IBAD = 8
IF (IBAD.EQ.0) IBAD = 16
C
C---- Store "bad" flag in IGFLAG
C
IF (IBAD.NE.16) IGFLAG(IRECG) = -IBAD
C
IF (ONLINE) THEN
WRITE (46) KREC,ISPOTPRO,ISIGPRO,JBGND,RMSBG,BGRATIO,
+ PKRATIOS,NXY,NXX,NYY,A,B,C,IBAD
IF (DEBUG(18)) WRITE (ITOUT,FMT=6118) KREC,ISPOTPRO,
+ ISIGPRO,JBGND,RMSBG,BGRATIO,PKRATIOS,NXY,NXX,NYY
6118 FORMAT (1X,4I6,3F5.1,3I5)
ELSE
C
C---- If running in batch mode, flag bad spots as rejected
C
IF (NBAD.EQ.1) THEN
WRITE (IOUT,FMT=6132)
IF (PKACCEPT) THEN
WRITE(IOUT,6143)
ELSE
WRITE(IOUT,6131)
END IF
WRITE (IOUT,FMT=6130)
WRITE (IOUT,FMT=6139)
6139 FORMAT(1X,'Note that gradients greater than 45 will be',
+ ' printed as 45')
END IF
C
C ****************
CALL GETHKL(IRECG,IH)
C ****************
C
XCG = XG(IRECG)
YCG = YG(IRECG)
CALL MMTOPX(XC,YC,XCG,YCG)
IXPIX = NINT(XC*FACT)
IYPIX = NINT(YC*FACT)
WRITE (IOUT,FMT=6134) (IH(II),II=1,4),XG(IRECG),YG(IRECG),
+ IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,PKRATIOS,A,B,C,
+ BADSTR(IBAD)
6134 FORMAT (1X,4I4,2F8.1,2I6,I7,I6,2F8.1,2X,3F7.1,1X,A)
C
C---- Reject the profile fitted I under all circumstances
C
C** ISDPRO(IRECG) = -9999
C
C---- Do not reject the summation integration value if failure is only on
C PKRATIO, unless PKREJECT flag set, in which case, do reject it.
C
C** IF ((BGRATIO.GT.BGRAT) .OR. (ISPOTPRO.LT.-5*ISIGPRO) .OR.
C** + (GRADBAD).OR. ((PKRATIOS.GT.PKRAT).AND.PKREJECT))
C** + ISDG(IRECG) = -9999
END IF
END IF
C
C
C ********************************************************************
C ********************************************************************
C---- End of second pass through reflections
C
C ********************************************************************
C ********************************************************************
800 CONTINUE
C
C---- Update NREF to allow for those rejected by MINT test (see above)
C
805 NREF = NREF - NMINTR
C
C---- Calculate averages for intensity analysis
C
DO 810 I = 1,10
IF (IANAL(I).EQ.0) GO TO 810
RATIO(I) = RATIO(I)/IANAL(I)
AVSD(I) = AVSD(I)/IANAL(I)
AVSDP(I) = AVSDP(I)/IANAL(I)
IF (IANALF(I).EQ.0) GO TO 810
PKRATIO(I) = PKRATIO(I)/IANALF(I)
810 CONTINUE
C
C
C---- Calculate averages for I/sigma analysis
C
DO 811 I = 1,9
IF (I.LE.8) THEN
FIOVSDP(9) = FIOVSDP(9) + FIOVSDP(I)
FIOVSDS(9) = FIOVSDS(9) + FIOVSDS(I)
PIOVSDP(9) = PIOVSDP(9) + PIOVSDP(I)
PIOVSDS(9) = PIOVSDS(9) + PIOVSDS(I)
IRESPF(9) = IRESPF(9) + IRESPF(I)
IRESPP(9) = IRESPP(9) + IRESPP(I)
IRESSF(9) = IRESSF(9) + IRESSF(I)
IRESSP(9) = IRESSP(9) + IRESSP(I)
ISDRESPF(9) = ISDRESPF(9) + ISDRESPF(I)
ISDRESPP(9) = ISDRESPP(9) + ISDRESPP(I)
ISDRESSF(9) = ISDRESSF(9) + ISDRESSF(I)
ISDRESSP(9) = ISDRESSP(9) + ISDRESSP(I)
NRESPF(9) = NRESPF(9) + NRESPF(I)
NRESPP(9) = NRESPP(9) + NRESPP(I)
NRESSF(9) = NRESSF(9) + NRESSF(I)
NRESSP(9) = NRESSP(9) + NRESSP(I)
END IF
C
C---- Profile full
C
N = NRESPF(I)
IF (N.NE.0) THEN
FIOVSDP(I) = FIOVSDP(I)/N
IRESPF(I) = IRESPF(I)/N
ISDRESPF(I) = ISDRESPF(I)/N
END IF
C
C---- Profile partial
C
N = NRESPP(I)
IF (N.NE.0) THEN
PIOVSDP(I) = PIOVSDP(I)/N
IRESPP(I) = IRESPP(I)/N
ISDRESPP(I) = ISDRESPP(I)/N
END IF
C
C---- Summation integration full
C
N = NRESSF(I)
IF (N.NE.0) THEN
FIOVSDS(I) = FIOVSDS(I)/N
IRESSF(I) = IRESSF(I)/N
ISDRESSF(I) = ISDRESSF(I)/N
END IF
C
C---- Summation integration partial
C
N = NRESSP(I)
IF (N.NE.0) THEN
PIOVSDS(I) = PIOVSDS(I)/N
IRESSP(I) = IRESSP(I)/N
ISDRESSP(I) = ISDRESSP(I)/N
END IF
811 CONTINUE
C ******************************
CALL REPORT(NUMBOX,USEOVRLD)
CALL XYSHIFT(0.0,0.0,0,0,XSH,YSH,NSH,2)
C ******************************
C
REWIND 46
IF (ONLINE) WRITE (ITOUT,FMT=6120) NBAD
IF (BRIEF) WRITE (IBRIEF,FMT=6120) NBAD
6120 FORMAT (2X,'Number of bad spots =',I4)
WRITE (IOUT,FMT=6120) NBAD
C
IF (ONLINE) WRITE (ITOUT,FMT=6123) NBADPK
IF (BRIEF) WRITE (IBRIEF,FMT=6123) NBADPK
6123 FORMAT (2X,'Number of spots with rejected peak pixels due to',
+ ' poor profile fit=',I4)
WRITE (IOUT,FMT=6123) NBADPK
C
IF (NBADBG.NE.0) THEN
WARN(10) = (WARN(10).OR.(NBADBG.GT.5))
IWARN(1,10) = MAX(IWARN(1,10),NBADBG)
WRITE(IOUT,6121) NBADBG,NBGMIN
IF (ONLINE) WRITE(ITOUT,6121) NBADBG,NBGMIN
IF (BRIEF) WRITE(IBRIEF,6121) NBADBG,NBGMIN
6121 FORMAT(/1X,I5,' Reflections rejected because fewer than',I3,
+ ' background pixels left after rejection')
END IF
C
IF (NREXP.NE.0) THEN
BGREXP = BGREXP/NREXP
WRITE (IOUT,FMT=6122) NREXP,BGREXP
6122 FORMAT (/1X,'Mean BGRATIO for the',I5,' Reflections whose raster',
+ ' expansion has been suppressed is',F4.1)
IF (ONLINE) WRITE (ITOUT,FMT=6122) NREXP,BGREXP
END IF
C
C
IF (NNOBOX.NE.0) THEN
WRITE (IOUT,FMT=6124) NNOBOX
6124 FORMAT (1X,I5,' Reflections not measured because there was no pr',
+ 'ofile for that measurement box')
IF (ONLINE) WRITE (ITOUT,FMT=6124) NNOBOX
IF (BRIEF) WRITE (IBRIEF,FMT=6124) NNOBOX
END IF
C
C---- Skip badspot examination if in batch mode
C
IF (.NOT.ONLINE) GO TO 860
C
C---- Badspot inspection (online operation only)
C
IF (NBAD.EQ.0) GO TO 860
IF (LPAUSE) GOTO 818
IF (WINOPEN) THEN
IXM = 200
IYM = 200
LINELEN = 75
NUMLIN = 6
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
WRITE(LINE,FMT=6125) NBAD
6125 FORMAT('There are',I5,' "bad" spots, which may be ',
+ 'reclassified manually')
CALL MXDWIO(LINE,1)
LINE = ' '
LINE = 'using the "Bad spots" menu option'
CALL MXDWIO(LINE, 1)
LINE = ' '
WRITE(LINE,FMT=6145)
6145 FORMAT('Do you want reclassify or inspect bad spots (N):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
C
YES = (STR1.EQ.'Y')
IF (YES) THEN
LPINTG = .TRUE.
LINE = 'After integration'
VALUESTR = ' '
ITOG = 3
IPPINTG = 45
IVHPAR = 3
CALL MXDPVL(IVHPAR, .TRUE., ITOG,LINE,
+ IPPINTG,VALUESTR,IERR)
END IF
CALL MXDCIO(1,0,0,0,0)
CALL XDLF_FLUSH_EVENTS(I)
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6126)
IF (BRIEF) WRITE (IBRIEF,FMT=6126)
6126 FORMAT (2X,'Do you want to check BAD SPOTS(Y or N)? ',/,1X,
+ 'If Yes, then ALL badspots must be inspected ',$)
C
C **********
if(.not.socklo) then
CALL YESNO(YES)
else
yes = .false.
end if
C **********
END IF
C
IF (LPINTG) GOTO 860
C
IF (YES) GO TO 830
C
C----- Flag NBAD spots as rejected in generate file
C and list them on for008 file
C
818 WRITE (IOUT,FMT=6132)
WRITE (IOUT,FMT=6130)
IF (.NOT.ERRSET) WRITE (IOUT,FMT=6139)
C
C
DO 820 I = 1,NBAD
READ (46) KREC,ISPOTPRO,ISIGPRO,JBGND,BGRMS,
+ BGRATIO,PKRATIOS,NXY,NXX,NYY,A,B,C,IBAD
C
C Pixel values only written out if ERRSET true
IF (ERRSET) READ (46) (OD(II),II=1,NXY)
IRECG = ABS(KREC)
C
C ****************
CALL GETHKL(IRECG,IH)
C ****************
C
XCG = IH(6)
YCG = IH(7)
CALL MMTOPX(XC,YC,XCG,YCG)
IXPIX = NINT(XC*FACT)
C
C---- Allow for switch inversion right to left of Mar images
C
IF (INVERTX) IXPIX = NREC - IXPIX + 1
IYPIX = NINT(YC*FACT)
CAL WRITE (IOUT,FMT=6134) (IH(II),II=1,4),XG(IRECG),YG(IRECG),
CAL + IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,
CAL + PKRATIOS,A,B,C,BADSTR(IBAD)
C** ISDG(IRECG) = -9999
C** ISDPRO(IRECG) = -9999
820 CONTINUE
C
GO TO 860
C
C---- Allow inspection of individual badspots if scanner value assigned
C (ERRSET) by keyword
C
830 IMAP = 0
WRITE (IOUT,FMT=6132)
IF (ERRSET) THEN
WRITE (ITOUT,FMT=6128)
IF (BRIEF) WRITE (IBRIEF,FMT=6128)
6128 FORMAT (2X,'Do you want a plot of each SPOT? ',$)
C
C **********
CALL YESNO(YES)
C **********
C
IF (YES) IMAP = 1
ELSE
WRITE(ITOUT,FMT=6129)
IF (BRIEF) WRITE(IBRIEF,FMT=6129)
6129 FORMAT(1X,'Inspection of pixel values of badspots is only',
+ ' possible if ',/,1X,'the detector error has been assigned',
+ ' a value (SCANNER keyword)')
END IF
C
C
N = 0
C
C
DO 850 I = 1,NBAD
READ (46) KREC,ISPOTPRO,ISIGPRO,JBGND,BGRMS,BGRATIO,
+ PKRATIOS,NXY,NXX,NYY,A,B,C,IBAD
IF (ERRSET) READ (46) (OD(II),II=1,NXY)
IRECG = ABS(KREC)
C
C ****************
CALL GETHKL(IRECG,IH)
C ****************
C
XCG = IH(6)
YCG = IH(7)
CALL MMTOPX(XC,YC,XCG,YCG)
IXPIX = NINT(XC*FACT)
IF (BRIEF) WRITE (IBRIEF,FMT=6172)
WRITE (ITOUT,FMT=6172)
WRITE (IOUT,FMT=6130)
C
C---- Allow for switch inversion right to left of Mar images
C
IF (INVERTX) IXPIX = NREC - IXPIX + 1
IYPIX = NINT(YC*FACT)
WRITE (IOUT,FMT=6134) (IH(II),II=1,4),XG(IRECG),YG(IRECG),
+ IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS,A,B,C,BADSTR(IBAD)
WRITE (ITOUT,FMT=6134) (IH(II),II=1,4),XG(IRECG),YG(IRECG),
+ IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS
WRITE(ITOUT,FMT=6174) A,B,C,BADSTR(IBAD)
IF (BRIEF) THEN
WRITE (IBRIEF,FMT=6134)(IH(II),II=1,4),XG(IRECG),YG(IRECG),
+ IXPIX,IYPIX,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS
WRITE (IBRIEF,FMT=6174) A,B,C,BADSTR(IBAD)
END IF
C
IF (IMAP.EQ.0) GO TO 840
C
C ****************************************
CALL SETMASK(MASK(1,1),LRAS)
C CALL RASPLOT(OD,NXX,NYY,MASK(1,1),IDR,ODSCAL)
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
C ****************************************
C
840 CONTINUE
IF (ONLINE) WRITE (ITOUT,FMT=6136)
IF (BRIEF) WRITE (IBRIEF,FMT=6136)
6136 FORMAT (' Reject (Y or N)? ',$)
WRITE (IOUT,FMT=6136)
C
C **********
CALL YESNO(YES)
C **********
C
IF (YES) WRITE (IOUT,FMT=6138)
6138 FORMAT (' Y')
IF (.NOT.YES) WRITE (IOUT,FMT=6140)
6140 FORMAT (' N')
C
IF (.NOT.YES) GO TO 850
C** ISDPRO(IRECG) = -9999
C** ISDG(IRECG) = -9999
850 CONTINUE
C
C---- Write intensities etc back to generate file
C modewr determines whether or not camera constants are also
C written back to generate file
C
860 MODEWR = 0
IF (ACCUMULATE) MODEWR = 2
C
IF (BRIEF) WRITE(IBRIEF,FMT=6141)
6141 FORMAT(/,1X,'Writing intensities back to generate file')
C
C---- Determine if a resolution cutoff is to be applied because I/sigma(I)
C is too small.
C
STHCUT = 0.0
IF (RESCUT.NE.0) THEN
DO 862 I = 2,NBIN1
IF (NRESPF(I).GT.20) THEN
RAT1 = FIOVSDP(I-1)
RAT2 = FIOVSDP(I)
ELSE IF (NRESPP(I).GT.20) THEN
RAT1 = PIOVSDP(I-1)
RAT2 = PIOVSDP(I)
ELSE IF (NRESPF(I).GT.0) THEN
RAT1 = FIOVSDP(I-1)
RAT2 = FIOVSDP(I)
ELSE IF (NRESPP(I).GT.0) THEN
RAT1 = PIOVSDP(I-1)
RAT2 = PIOVSDP(I)
ELSE
GOTO 864
END IF
IF (RAT2.LT.RESCUT) THEN
X = 1.0
IF (RAT1-RAT2.NE.0) X = (RAT1-RESCUT)/(RAT1-RAT2)
DBIN1 = 1.0/(DBIN(I-1)**2)
DBIN2 = 1.0/(DBIN(I)**2)
STHCUT = DBIN1 + X*(DBIN2-DBIN1)
GOTO 864
END IF
862 CONTINUE
END IF
C
864 IF (PRECESS) THEN
C
C **********************
CALL PWRGEN(MODEWR,PROFILE)
C **********************
C
ELSE
C
C ****************************
CALL WRGEN(MODEWR,PROFILE,ADDPART)
C
END IF
C
C---- Close BADSPOTS file
C
IF (ONLINE) CLOSE (UNIT=46)
C
RETURN
END
C== PROFGRAD ==
SUBROUTINE PROFGRAD(OD,IHX,IHY,IXRIM,IYRIM,GRAD)
C ===============================================
IMPLICIT NONE
C
C
C---- Determine an average profile gardient, for use in scaling up
C sigma values (allowing for instrumental errors).
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IHX,IHY,IXRIM,IYRIM
REAL GRAD
C ..
C .. Array Arguments ..
INTEGER OD(-IHY:IHY,-IHX:IHX)
C ..
C .. Local Scalars ..
INTEGER I,IJ,IRIM,IH
REAL GRADX,GRADY
C ..
C .. Local Arrays ..
INTEGER ISTRIP(MAXDIM)
C ..
C .. External Subroutines ..
EXTERNAL FEDGE,ODPLOT4
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX,SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C ..
C .. Equivalences ..
C ..
SAVE
C
C
C---- Transfer the stripe of pixel values along X through centre of
C peak into ISTRIP
C
IJ = 0
DO 10 I = -IHX,IHX
IJ = IJ + 1
ISTRIP(IJ) = OD(0,I)
10 CONTINUE
C
C---- find the average gradient in peak region
C
IRIM = IXRIM
IH = IHX
CALL GRADMEAN(ISTRIP,IH,IRIM,GRADX)
C
C---- Now repeat the procedure in Y direction
C Transfer the stripe of pixel values along Y through centre of
C peak into ISTRIP
C
IJ = 0
DO 20 I = -IHY,IHY
IJ = IJ + 1
ISTRIP(IJ) = OD(I,0)
20 CONTINUE
C
C---- find the average gradient in peak region
C
IRIM = IYRIM
IH = IHY
CALL GRADMEAN(ISTRIP,IH,IRIM,GRADY)
GRAD = MAX(GRADX,GRADY)
END
C== PROFREAD ==
SUBROUTINE PROFREAD(MASKREJ,PQSUMS,PQSUMINV,PROFSUMS,WPROFSUMS,
+ XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,CENTRAL,IOPTRAS,
+ PROFACT)
C =============================================================
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER ICENBOX
REAL XCGCEN,YCGCEN
LOGICAL CENTRAL
C ..
C .. Array Arguments ..
INTEGER MASKREJ(NREJMAX,NMASKS),IOPTRAS(3,NMASKS)
REAL PQSUMINV(9,NMASKS),PQSUMS(6,NMASKS),
+ PROFSUMS(4,NMASKS+1),WPROFSUMS(4,NMASKS+1),RMSBGA(NMASKS),
+ XCGBOX(NMASKS),YCGBOX(NMASKS),PROFACT(NMASKS)
C ..
C ..
C .. Local Scalars ..
INTEGER I,J,INPRF,NCH,NCH4,IPRUNIT,IFAIL,NXX,NYY,NXY,JBOX,IDR,
+ NXLINEL,NYLINEL,NUMBOXL,NPK,NRSPOTS,NXXL,NYYL,KBOX
REAL SIGMAP,SIGMAPSQ,RMSBG
CHARACTER LPROFN*100,PROFFN*100,STR*3
C ..
C .. Local Arrays ..
INTEGER MASK(MAXBOX),LRAS(5)
REAL SUMPQ(6)
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL CCPLWC,CCPOPN,UGTENV,RASPLOT4,MPAUSE,
+ SETMASK,SETSUMS,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C ..
C .. Equivalences ..
SAVE
DATA INPRF/0/,IDR/1/
C
C
INPRF = INPRF + 1
C
C---- Make up the filename for profiles from template
C
LPROFN = ' '
CALL UGTENV('PROFILE',LPROFN)
NCH = LENSTR(LPROFN)
DO 10 I=1,NCH
IF (LPROFN(I:I).EQ.'.') THEN
NCH4 = I - 1
GOTO 20
END IF
10 CONTINUE
NCH4 = NCH
20 WRITE(STR,FMT=6000) INPRF
6000 FORMAT(I3.3)
PROFFN = LPROFN(1:NCH4)//'_'//STR//'.PRF'
NCH = NCH4 + 8
C
C---- Make lower case for unix systems
C
C ************
CALL CCPLWC(PROFFN)
C ************
IPRUNIT = 44
IFAIL = 1
C
C **************************************
CALL CCPOPN(-IPRUNIT,PROFFN,3,2,80,IFAIL)
C **************************************
C
C----
READ(IPRUNIT,END=90) NUMBOXL,NXLINEL,NYLINEL
C
C---- Test NUMBOX,NXLINE,NYLINE
C
IF ((NUMBOXL.NE.NUMBOX).OR.(NXLINEL.NE.NXLINE).OR.
+ (NYLINEL.NE.NYLINE)) THEN
WRITE(IOUT,FMT=6002) NUMBOX,NXLINE,NYLINE,NUMBOXL,
+ NXLINEL,NYLINEL
IF (ONLINE) WRITE(ITOUT,FMT=6002) NUMBOX,NXLINE,NYLINE,
+ NUMBOXL,NXLINEL,NYLINEL
6002 FORMAT(//1X,'*** FATAL ERROR ***',/,1X,'The number ',
+ 'of standard profiles, or the number of bins in the',
+ /,1X,'X and Y directions specified for processing the',
+ ' current images differs from that',/,1X,' used when ',
+ 'forming the profiles being read from the input file',
+ /,1X,'For current images, the numbers are',3I4,/,1X,
+ 'For the profiles in the file they are',3I4,/,1X,
+ 'You must change the binning for the current images',
+ ' (given on the PROFILE keyword)',/,1X,'so that it',
+ ' matches that used when generating the saved profiles',
+ /,1X,'being read')
CALL SHUTDOWN
END IF
WRITE (IOUT,FMT=6010) NUMBOX,PROFFN(1:NCH)
6010 FORMAT (/1X,I3,' Profiles for the integration pass will be',
+ ' read from file:',/,1X,A)
IF (ONLINE) WRITE (ITOUT,FMT=6010) NUMBOX,PROFFN(1:NCH)
IF (BRIEF) WRITE (IBRIEF,FMT=6010) NUMBOX,PROFFN(1:NCH)
READ(IPRUNIT,END=90) IOPTRAS,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,
+ CENTRAL
C
C
DO 30 JBOX = 1,NUMBOX
NXX = ISIZE(JBOX,1)
NYY = ISIZE(JBOX,2)
NXY = NXX*NYY
READ(IPRUNIT,END=90) KBOX,NXXL,NYYL,NRSPOTS,RMSBG
IF ((NXX.NE.NXXL).OR.(NYY.NE.NYYL)) THEN
WRITE(IOUT,FMT=6020) KBOX,NXX,NYY,NXXL,NYYL
IF (ONLINE) WRITE(ITOUT,FMT=6020) KBOX,NXX,NYY,NXXL,NYYL
6020 FORMAT(/,1X,'*** FATAL ERROR ***',/,1X,'For profile number',
+ I3,' the measurement box size calculated for the',/,
+ 1X,'current image does not match that in the file',
+ ' containing the saved profiles',/,1X,'Box size ',
+ 'for current image is',2I3,' that read from file is',
+ 2I3,/,1X,'Check that all processing parameters are the',
+ ' same for current images and those used to generate',
+ /,1X,'the saved profiles (RASTER, THICKNESS, ',
+ 'resolution limits etc)')
CALL SHUTDOWN
END IF
READ(IPRUNIT,END=90) (IPROFL(I,JBOX),I=1,NXY)
READ (IPRUNIT,END=90) (MASKREJ(I,JBOX),I=1,NREJMAX),
+ (PQSUMS(I,JBOX),I=1,6), (PQSUMINV(I,JBOX),I=1,9),
+ (PROFSUMS(I,JBOX),I=1,4),(WPROFSUMS(I,JBOX),I=1,4)
C
C---- Test for valid box (ie not off edge of detector)
C
IF (.NOT.BOX(JBOX)) GOTO 30
C
C
C---- Calculate the profile factor for this profile
C call setmask,setsums to get number of peak pixels
C
C **********************************
LRAS(1) = NXX
LRAS(2) = NYY
IF (PROPT) THEN
DO 32 I = 1,3
LRAS(I+2) = IOPTRAS(I,JBOX)
32 CONTINUE
ELSE
DO 34 I = 3,5
LRAS(I) = IRAS(I)
34 CONTINUE
END IF
CALL SETMASK(MASK,LRAS)
CALL SETSUMS(MASK,LRAS,SUMPQ)
C **********************************
C
NPK = NINT(SUMPQ(5))
SIGMAP = PROFSUMS(3,JBOX)
SIGMAPSQ = PROFSUMS(4,JBOX)
PROFACT(JBOX) = SIGMAP*SIGMAP/ (NPK*SIGMAPSQ)
C
C
IF (DEBUG(18)) THEN
WRITE (IOUT,FMT=6030) JBOX,NXX,NYY,NRSPOTS,RMSBG,
+ PROFACT(JBOX),LRAS,NPK,(PROFSUMS(I,JBOX),I=1,4),
+ (WPROFSUMS(I,JBOX),I=1,4)
6030 FORMAT (1X,'Profile for BOX',I3,' Read in',/1X,'Box size',I3,
+ ' by',I3,' Number of reflections',I5,' RMSBG=',F4.1,' PRO',
+ 'FILE Factor=',F4.2,/,1X,'LRAS',5I5,' NPK',I3,
+ /,1X,'PROFSUMS',4F12.0/,1X,'WPROFSUMS',4F12.0)
IF (ONLINE) WRITE (ITOUT,FMT=6030) JBOX,NXX,NYY,NRSPOTS,RMSBG,
+ PROFACT(JBOX),LRAS,NPK,(PROFSUMS(I,JBOX),I=1,4),
+ (WPROFSUMS(I,JBOX),I=1,4)
END IF
C
C---- Print all profiles if requested
C
IF (LPRINT(11)) THEN
WRITE (IOUT,FMT=6040) JBOX,NXX,NYY,NRSPOTS,RMSBG,
+ PROFACT(JBOX)
6040 FORMAT (//1X,'Profile for BOX',I3,6X,'Box size',I3,' by',I3,/1X,
+ 'Number of reflections in PROFILE',I5,' RMSBG',F5.1,' PR',
+ 'OFILE Factor ',F4.2)
IF (ONLINE) WRITE (ITOUT,FMT=6040) JBOX,NXX,NYY,NRSPOTS,
+ RMSBG,PROFACT(JBOX)
IF (BRIEF) WRITE (IBRIEF,FMT=6040) JBOX,NXX,NYY,NRSPOTS,
+ RMSBG,PROFACT(JBOX)
C
C *******************************************
CALL RASPLOT4(IPROFL(1,JBOX),NXX,NYY,MASK,
+ MASKREJ(1,JBOX),IDR)
C *******************************************
IF (BRIEF.AND.(.NOT.GRAPH)) CALL MPAUSE
C
END IF
C
C
30 CONTINUE
C
C
CLOSE (UNIT=IPRUNIT)
RETURN
90 WRITE (IOUT,FMT=6050) PROFFN(1:NCH)
6050 FORMAT (///1X,'**** FATAL ERROR *****',/1X,'EOF When reading arr',
+ 'ay IBOX from file ',A)
IF (ONLINE) WRITE (ITOUT,FMT=6050) PROFFN(1:NCH)
IF (BRIEF) WRITE (IBRIEF,FMT=6050) PROFFN(1:NCH)
CALL SHUTDOWN
END
C== PROFWRITE ==
SUBROUTINE PROFWRITE(MASKREJ,PQSUMS,PQSUMINV,PROFSUMS,WPROFSUMS,
+ RMSBGA,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,CENTRAL,
+ IOPTRAS)
C =============================================================
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
INTEGER ICENBOX
REAL XCGCEN,YCGCEN
LOGICAL CENTRAL
C ..
C .. Array Arguments ..
INTEGER MASKREJ(NREJMAX,NMASKS),IOPTRAS(3,NMASKS)
REAL PQSUMINV(9,NMASKS),PQSUMS(6,NMASKS),
+ PROFSUMS(4,NMASKS+1),WPROFSUMS(4,NMASKS+1),RMSBGA(NMASKS),
+ XCGBOX(NMASKS),YCGBOX(NMASKS)
C ..
C ..
C .. Local Scalars ..
INTEGER I,J,IOUTPRF,NCH,NCH4,IPRUNIT,IFAIL,NXX,NYY,NXY,JBOX
CHARACTER LPROFN*100,PROFFN*100,STR*3
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL CCPLWC,CCPOPN,UGTENV
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C ..
C .. Equivalences ..
SAVE
DATA IOUTPRF/0/
C
C
IOUTPRF = IOUTPRF + 1
C
C---- Make up the filename for profiles from template
C
LPROFN = ' '
CALL UGTENV('PROFILE',LPROFN)
NCH = LENSTR(LPROFN)
DO 10 I=1,NCH
IF (LPROFN(I:I).EQ.'.') THEN
NCH4 = I - 1
GOTO 20
END IF
10 CONTINUE
NCH4 = NCH
20 WRITE(STR,FMT=6003) IOUTPRF
6003 FORMAT(I3.3)
PROFFN = LPROFN(1:NCH4)//'_'//STR//'.PRF'
NCH = NCH4 + 8
C
C---- Make lower case for unix systems
C
C ************
CALL CCPLWC(PROFFN)
C ************
IPRUNIT = 44
IFAIL = 1
C
C **************************************
CALL CCPOPN(-IPRUNIT,PROFFN,1,2,80,IFAIL)
C **************************************
C
C----
WRITE(IPRUNIT) NUMBOX,NXLINE,NYLINE
WRITE(IPRUNIT) IOPTRAS,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,
+ CENTRAL
C
C
DO 30 JBOX = 1,NUMBOX
NXX = ISIZE(JBOX,1)
NYY = ISIZE(JBOX,2)
NXY = NXX*NYY
WRITE (IPRUNIT) JBOX,NXX,NYY,NRFBOX(JBOX),RMSBGA(JBOX)
WRITE(IPRUNIT) (IPROFL(I,JBOX),I=1,NXY)
WRITE (IPRUNIT) (MASKREJ(I,JBOX),I=1,NREJMAX),
+ (PQSUMS(I,JBOX),I=1,6), (PQSUMINV(I,JBOX),I=1,9),
+ (PROFSUMS(I,JBOX),I=1,4),(WPROFSUMS(I,JBOX),I=1,4)
30 CONTINUE
C
C
CLOSE (UNIT=IPRUNIT)
WRITE (IOUT,FMT=6090) NUMBOX,PROFFN(1:NCH)
6090 FORMAT (/1X,I3,' Profiles written to file ',A)
IF (ONLINE) WRITE (ITOUT,FMT=6090) NUMBOX,PROFFN(1:NCH)
IF (BRIEF) WRITE (IBRIEF,FMT=6090) NUMBOX,PROFFN(1:NCH)
C
RETURN
END
C== PRSETUP ==
SUBROUTINE PRSETUP
C
C---- This sets up the boundaries for the areas over which the standard
C profiles will be determined (unless these have been explicitly
C set up by the user). The areas are rectangular, and are defined by
C a series of lines running parallel to the fast (Y) and slow (X)
C directions of the digitised image.
C By default, the physical size of the detector, or the specified
C maximum resolution limit (if smaller), is used to define these
C standard areas.
C For low resolution data (currently below 2.7A) there will be a total
C of 9 areas, for high resolution there are 25 areas of which only 21
C fall within the circle of the detector (if circular).
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,K1
REAL RADP,RADI,RAD,RRMAX,STHMAX,XMID,YMID,FRAC,FRAC2,XORG,YORG,
+ RADSQ,RDETSQ,X,Y,XLIM,YLIM,DTOR,RADPX,RADPY,XMAXP,YMAXP,
+ XDMIN,XDMAX,YDMIN,YDMAX,XRDNG,YDRNG
C ..
C .. Local Arrays ..
REAL XL(2),R1(4),R2(4)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN,COS,NINT,SIN,SQRT,MAX,MIN,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C
C .. Data statements ..
DTOR = ATAN(1.0)/45.0
C
C---- Initialise arrays
C
DO 4 I = 1,NMASKS
XPMAX(I) = 0.0
YPMAX(I) = 0.0
BOX(I) = .FALSE.
DO 2 J = 1,2
IXBOX(I,J) = 0
IYBOX(I,J) = 0
2 CONTINUE
4 CONTINUE
DO 8 I = 0,NNLINE
DO 6 J =0,NNLINE
IBOX(I,J) = 0
6 CONTINUE
8 CONTINUE
C
C---- First see if the profile binning has already been set by keyword,
C and if not, assign HIGHRES (25 boxes) or LOWRES (9 boxes)
C
IF (.NOT.PRSET) THEN
IF (WAVE/DSTMAX.LT.2.5) THEN
HIGHRES = .TRUE.
LOWRES = .FALSE.
ELSE
HIGHRES = .FALSE.
LOWRES = .TRUE.
END IF
END IF
C---- Now determine if detector is offset, in which case the default
C is to divide it into 9 areas. If direct beam coords are more than
C 15mm from centre of detector, treat as offset
C Get mm coords of centre of image
C
XMID = (0.5*NREC)/FACT
YMID = (0.5*IYLEN)/FACT
OFFDET = (ABS(XCEN-XMID).GT.1500.0 .OR.
+ ABS(YCEN-YMID).GT.1500.0)
C
C---- For binning purposes use the centre of the detctor as origin
C ***** Note that for ofline scanned images, must use
C XCEN,YCEN for very image *** This isn't done yet.
C
IF (OFFDET.AND.CIRCULAR.AND.(.NOT.LINESET)) THEN
C
C---- Special binning for offset detector
C
WRITE(IOUT,FMT=6006)
IF (ONLINE) WRITE(ITOUT,FMT=6006)
IF (BRIEF) WRITE(IBRIEF,FMT=6006)
6006 FORMAT(/,/,1X,'*** ERROR ***',/,
+ 1X,'If the supplied direct beam coordinates are more',
+ ' than',/,1X,'15mm from the centre of the detector,then',
+ ' the detector is',/,1X,'treated as being offset and ',
+ 'the bins for the standard profiles',/,1X,'must be set',
+ ' up explicitly using PROFILE XLINES,YLINES')
CALL SHUTDOWN
ELSE
C
C---- First get maximum radius from resolution limit
C DSTMAXS comes from /REEKE/. Use DSTMAXS rather than DSTMAX because
C DSTMAX is changed by CONVOLUTE and AUTOMATCH (in NEWLIST)
C
STHMAX = ASIN(0.5*DSTMAXS)
RRMAX = XTOFD*TAN(2.0*STHMAX)
RAD = MIN(RRMAX,RMAX)
C
C---- RMAX is the physically largest radius possible, set in CONTROL
C to sqrt(xmax**2+ymax**2) for orthogonal detectors or including
C XOFF and YOFF for circular.
C RRMAX is the largest radius from the defined resolution limit.
C RAD is the smaller of RMAX and RRMAX
C XMAXP is the smaller fo physical size in X and RMAX
C YMAXP is the smaller fo physical size in Y and RMAX
C
C---- To check valid boxes, need to test that at least one corner lies
C within scanned area of detector. The scanned area is here assumed to
C be a circle centred on the central pixel of the image with a radius
C 4 pixels less than half the image width (because this is the case for
C the prototype Mar scanners. For orthogonal detectors, use distance to
C corners
C
IF (CIRCULAR) THEN
RDETSQ = ((NREC/2-4)*RAST*100.0)**2
ELSE
RDETSQ = ((NREC/2-4)*RAST*100.0)**2 +
+ ((IYLEN/2-4)*RAST*100.0)**2
XMAXP = MIN((NREC/2)*RAST*100.0,RAD)
RADPX = XMAXP/SQRT(2.0)
YMAXP = MIN((IYLEN/2)*RAST*100.0,RAD)
RADPY = YMAXP/SQRT(2.0)
END IF
RADSQ = RRMAX*RRMAX
C
C---- RADP such that we get an inscribed square and only 3 boxes in first
C and last stripes. To make this work, must use the midpoint of the
C detector (XORG,YORG) when setting up the boundary lines rather than
C XCEN,YCEN which may be slightly displaced. This may mean that the
C boundary lines are not exactly symmetric wrt direct beam position
C but this should not cause problems
C
RADP = RAD/SQRT(2.)
C
C---- If offset detector, all make areas the same size
C
IF (OFFDET) THEN
ISIGN = -1
IF (INVERTX) ISIGN = 1
XDMIN = MAX(0.0,XMID+ISIGN*XOFF-RAD)
XDMAX = MIN(REAL(NREC)/FACT,XMID+ISIGN*XOFF+RAD)
XDRNG = XDMAX - XDMIN
YDMIN = MAX(0.0,XMID+YOFF-RAD)
YDMAX = MIN(REAL(IYLEN)/FACT,YMID+YOFF+RAD)
YDRNG = YDMAX - YDMIN
END IF
IF (DEBUG(41)) THEN
WRITE(IOUT,FMT=6000)STHMAX/DTOR,0.01*RRMAX,0.01*SQRT(RDETSQ),
+ HIGHRES,LOWRES,OFFDET,PRSET,CIRCULAR,
+ XMID,YMID,XCEN,YCEN,XDMIN,XDMAX,YDMIN,YDMAX,XOFF,YOFF
IF (ONLINE) WRITE(ITOUT,FMT=6000) STHMAX/DTOR,0.01*RRMAX,
+ 0.01*SQRT(RDETSQ),HIGHRES,LOWRES,OFFDET,
+ PRSET,CIRCULAR,XMID,YMID,XCEN,YCEN,XDMIN,XDMAX,
+ YDMIN,YDMAX,XOFF,YOFF
6000 FORMAT(1X,'Thetamax (deg)',F7.1,' Radius of resln limit',
+ ' (mm)',F7.2,/,1X,'Physical radial limit',F7.2,/,1X,
+ ' HIGHRES ',L1,' LOWRES ',L1,' OFFDET ',L1,' PRSET ',
+ L1,' CIRCULAR ',L1,
+ /,1X,'Centre of image (10mu units) XMID,YMID',2F8.1,
+ /,1X,'Direct beam coords (10 mu) XCEN,YCEN',2F7.1,/,1X,
+ 'X limits for offset detector (mm):',2F9.0,/,1X,
+ 'Y limits for offset detector (mm):',2F9.0,/,1X,
+ 'XOFF,YOFF',2F10.2)
END IF
C
C---- For film, direct beam position is not necessarily in the centre of
C the digitised image, so must use XCEN,YCEN (which may be different for
C every film) to do the binning
C
IF (IMGP) THEN
XORG = XMID
YORG = YMID
ELSE
XORG = XCEN
YORG = YCEN
END IF
C
IF (HIGHRES) THEN
C
IF (CIRCULAR) THEN
C---- Default high resolution binning to give 21 actual areas (4 outside
C detector limits)
C
C
C---- Fraction for division of inner bins (Set empirically)
C
FRAC = 28.0/64.0
NXLINE = 6
NYLINE = 6
C
XLINE(1) = MAX((XORG-RAD),0.0)
XLINE(2) = XORG - RADP
XLINE(3) = XORG - RADP*FRAC
XLINE(4) = XORG + RADP*FRAC
XLINE(5) = XORG + RADP
XLINE(6) = MIN((XORG+RAD),REAL(NREC)/FACT)
YLINE(1) = MAX((YORG-RAD),0.0)
YLINE(2) = YORG - RADP
YLINE(3) = YORG - RADP*FRAC
YLINE(4) = YORG + RADP*FRAC
YLINE(5) = YORG + RADP
YLINE(6) = MIN((YORG+RAD),REAL(IYLEN)/FACT)
ELSE
C
C---- Code for orthogonal scanners is actually the same at present
C
NXLINE = 6
NYLINE = 6
C
IF (OFFDET) THEN
XSTEP = XDRNG/5.
XLINE(1) = XDMIN
XLINE(2) = XLINE(1) + XSTEP
XLINE(3) = XLINE(2) + XSTEP
XLINE(4) = XLINE(3) + XSTEP
XLINE(5) = XLINE(4) + XSTEP
XLINE(6) = XDMAX
YSTEP = YDRNG/5.
YLINE(1) = YDMIN
YLINE(2) = YLINE(1) + YSTEP
YLINE(3) = YLINE(2) + YSTEP
YLINE(4) = YLINE(3) + YSTEP
YLINE(5) = YLINE(4) + YSTEP
YLINE(6) = YDMAX
ELSE
FRAC = 28.0/64.0
XLINE(1) = MAX((XORG-RAD),0.0)
XLINE(2) = XORG - RADPX
XLINE(3) = XORG - RADPX*FRAC
XLINE(4) = XORG + RADPX*FRAC
XLINE(5) = XORG + RADPX
XLINE(6) = MIN((XORG+RAD),REAL(NREC)/FACT)
YLINE(1) = MAX((YORG-RAD),0.0)
YLINE(2) = YORG - RADPY
YLINE(3) = YORG - RADPY*FRAC
YLINE(4) = YORG + RADPY*FRAC
YLINE(5) = YORG + RADPY
YLINE(6) = MIN((YORG+RAD),REAL(IYLEN)/FACT)
END IF
END IF
ELSE IF (LOWRES) THEN
IF (CIRCULAR) THEN
C
C---- Default low resolution binning to give 9 areas
C
NXLINE = 4
NYLINE = 4
C
C---- Inner line...set empirically
C
FRAC2 = 35./90.
RADI = RAD*FRAC2
XLINE(1) = MAX((XORG-RAD),0.0)
XLINE(2) = XORG - RADI
XLINE(3) = XORG + RADI
XLINE(4) = MIN((XORG+RAD),REAL(NREC)/FACT)
YLINE(1) = MAX((YORG-RAD),0.0)
YLINE(2) = YORG - RADI
YLINE(3) = YORG + RADI
YLINE(4) = MIN((YORG+RAD),REAL(IYLEN)/FACT)
ELSE
C
C---- Code for orthogonal scanners
C
C---- Default low resolution binning to give 9 areas
C
NXLINE = 4
NYLINE = 4
IF (OFFDET) THEN
XSTEP = XDRNG/3.
XLINE(1) = XDMIN
XLINE(2) = XLINE(1) + XSTEP
XLINE(3) = XLINE(2) + XSTEP
XLINE(4) = XDMAX
YSTEP = YDRNG/3.
YLINE(1) = YDMIN
YLINE(2) = YLINE(1) + YSTEP
YLINE(3) = YLINE(2) + YSTEP
YLINE(4) = YDMAX
ELSE
C
C---- Inner line...set empirically
C
FRAC2 = 35./90.
RADI = RAD*FRAC2
XLINE(1) = MAX((XORG-RAD),0.0)
XLINE(2) = XORG - RADI
XLINE(3) = XORG + RADI
XLINE(4) = MIN((XORG+RAD),REAL(NREC)/FACT)
YLINE(1) = MAX((YORG-RAD),0.0)
YLINE(2) = YORG - RADI
YLINE(3) = YORG + RADI
YLINE(4) = MIN((YORG+RAD),REAL(IYLEN)/FACT)
END IF
END IF
END IF
END IF
C
C
C---- Now set up the maximum coordinates (in X and Y) for each box,
C XPMAX,YPMAX for raster expansion. Also calculate IXBOX,IYBOX,
C the box coordinates, IBOX() (gives box number for given xline,
C yline) and BOX (true for boxes lying on detector and within
C resolution limits). Cannot calculate
C expansion because the optimum raster parameters are not yet set.
C
NUMBOX = 0
DO 50 I = 1,NXLINE-1
XLIM = MAX(ABS(XLINE(I)-XCEN),ABS(XLINE(I+1)-XCEN))
XL(1) = XLINE(I)
XL(2) = XLINE(I+1)
DO 40 J = 1,NYLINE-1
NUMBOX = NUMBOX + 1
IF (J.EQ.1) NPFIRST(I) = NUMBOX
YLIM = MAX(ABS(YLINE(J)-YCEN),ABS(YLINE(J+1)-YCEN))
XPMAX(NUMBOX) = XLIM
YPMAX(NUMBOX) = YLIM
IBOX(I,J) = NUMBOX
DO 10 K=1,2
IXBOX(NUMBOX,K) = XL(K)
IYBOX(NUMBOX,K) = YLINE(J+K-1)
10 CONTINUE
C
C---- Calculate distance of all 4 box corners from centre of detector
C (assumed to be at the centre of digitised image) (This is R2)
C and from direct beam position (R1).
IJ = 0
DO 30 K = 1,2
X = XL(K)
DO 20 K1 = 1,2
IJ = IJ + 1
Y = YLINE(J+K1-1)
R1(IJ) = (X-XCEN)**2 + (Y-YCEN)**2
R2(IJ) = (X-XMID)**2 + (Y-YMID)**2
20 CONTINUE
30 CONTINUE
C
C---- Test that a corner of box is within detector radius and
C within resolution limit, if so box is valid
C
DO 32 IJ = 1,4
IF ((R1(IJ).LT.RADSQ).AND.(R2(IJ).LT.RDETSQ))
+ BOX(NUMBOX) = .TRUE.
32 CONTINUE
40 CONTINUE
50 CONTINUE
C
C---- If using default high resolution binning, set boxes 1,5,21,25
C false (they may end up TRUE from above tests because of rounding
C errors. For ORTHOG (ie rectangular) scanners do not do this.
C
IF (HIGHRES.AND.CIRCULAR) THEN
BOX(1) = .FALSE.
BOX(5) = .FALSE.
BOX(21) = .FALSE.
BOX(25) = .FALSE.
END IF
C
C---- Special case if only one box, (none of corners will be within
C resolution limit)
C
IF ((NXLINE.EQ.2).AND.(NYLINE.EQ.2)) BOX(1) = .TRUE.
C
C---- Now make the first and last lines in X and Y correspond to the
C physical limits of the detector, as otherwise if the direct beam
C position is at all displaced from the centre of the image then
C OSCGEN may generate reflections which lie outside the first
C and last lines if these correspond to a resolution lower than
C the maximum possible (ie the physical edge of detector)
C ONLY DO THIS if using default XLINE,YLINE, but NOT if these have
C been user specified.
C
IF (.NOT.LINESET) THEN
XLINE(1) = 0.0
XLINE(NXLINE) = REAL(NREC)/FACT
YLINE(1) = 0.0
YLINE(NYLINE) = REAL(IYLEN)/FACT
END IF
C
C---- debug
C
IF (DEBUG(41)) THEN
DO 60 I = 1,NUMBOX
WRITE(IOUT,FMT=6010) I,BOX(I),
+ XPMAX(I),YPMAX(I),(IXBOX(I,K),K=1,2),
+ (IYBOX(I,K),K=1,2)
IF (ONLINE) WRITE(ITOUT,FMT=6010) I,BOX(I),
+ XPMAX(I),YPMAX(I),(IXBOX(I,K),K=1,2),
+ (IYBOX(I,K),K=1,2)
6010 FORMAT(1X,'Num',I3,' Genuine ',L1,' XPMAX,YPMAX',2F7.0,
+ ' Box X coords (10mu)',2I6,' Box Y coords (10mu)',2I6)
60 CONTINUE
WRITE(IOUT,FMT=6002) NXLINE,(XLINE(I),I=1,NXLINE)
WRITE(IOUT,FMT=6004) NYLINE,(YLINE(I),I=1,NYLINE)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=6002) NXLINE,(XLINE(I),I=1,NXLINE)
WRITE(ITOUT,FMT=6004) NYLINE,(YLINE(I),I=1,NYLINE)
END IF
6002 FORMAT(1X,'Number of X-lines',I3,/,1X,'Coords (10 mu units)',
+ 10F7.0)
6004 FORMAT(1X,'Number of Y-lines',I3,/,1X,'Coords (10 mu units)',
+ 10F7.0)
END IF
RETURN
END
SUBROUTINE PRSUMMARY(NREPEAT,NSEG,LASTFILM,RSUMM,ISUMM,PRFSUM,
+ CELL,OLDCELL,DELPHI,NEWPREF,DISPMENU)
C ===================================================================
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM=200)
C
C ..
C .. Scalar Arguments ..
INTEGER NREPEAT,NSEG
LOGICAL NEWPREF,DISPMENU
C
C ..
C .. Array Arguments ..
INTEGER LASTFILM(100),ISUMM(20,MAXPAX)
REAL RSUMM(12,MAXPAX),PRFSUM(25,MAXPAX),CELL(6),OLDCELL(6),
+ DELPHI(3)
C ..
C .. Local Scalars ..
INTEGER I,ISTART,IIEND,IWIDTH,NIMG,ICYC,IADD,NLAST,IFIRST,
+ IXM,IYM,LINELEN,NUMLIN
LOGICAL NULINE
CHARACTER LINE*80,LINE2*80,STR1*1
C ..
C .. Local Arrays ..
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL MXDCIO,WINDIO,MXDWIO,MXDRIO,MPARSE,CCPUPC
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
IWIDTH = 10
C
WRITE(IOUT,FMT=6000) OLDCELL,CELL
IF (ONLINE) WRITE(ITOUT,FMT=6000) OLDCELL,CELL
6000 FORMAT(//,1X,'Cell refinement is complete',/,1X,'Starting cell',
+ 3F9.3,3F9.3,/,1X,'Refined cell ',3F9.3,3F9.3)
IF (DISPMENU) THEN
IXM = 200
IYM = 200
LINELEN = 80
NUMLIN = 40
C
C Create IO window
C
CALL MXDCIO(0,LINELEN, NUMLIN, IXM,IYM)
NULINE = .TRUE.
WRITE(IOLINE,FMT=6000) OLDCELL,CELL
CALL WINDIO(NULINE)
END IF
C
NIMG = LASTFILM(NSEG)
IF (.NOT.NEWPREF) NIMG = NIMG - NSEG
NLAST = NIMG*(NREPEAT+1)
IF (DEBUG(1)) THEN
WRITE(IOUT,FMT=6004) NIMG,NSEG,
+ (LASTFILM(I),I=1,10)
IF (ONLINE) WRITE(ITOUT,FMT=6004) NIMG,NSEG,
+ (LASTFILM(I),I=1,10)
6004 FORMAT(1X,'NIMG',I3,' NSEG',I3,' LASTFILM',10I4)
END IF
C
WRITE(IOUT,FMT=6001)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
6001 FORMAT(/,1X,'Rms positional error (mm) as a function of cycle',
+ ' for each image.')
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6001)
CALL WINDIO(NULINE)
END IF
ISTART = 1
4 IIEND = ISTART + IWIDTH - 1
IIEND = MIN(IIEND,NIMG)
WRITE(IOUT,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
IF (ONLINE) WRITE(ITOUT,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
6002 FORMAT(6X,'Image',I4,9I6)
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
CALL WINDIO(NULINE)
END IF
IADD = 0
DO 10 ICYC = 1,NREPEAT+1
WRITE(IOUT,FMT=6010) ICYC,(0.01*RSUMM(3,I), I=ISTART+IADD,
+ IIEND+IADD)
IF (ONLINE) WRITE(ITOUT,FMT=6010) ICYC,
+ (0.01*RSUMM(3,I), I=ISTART+IADD,IIEND+IADD)
6010 FORMAT(1X,'Cycle',I2,3X,10F6.3)
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6010) ICYC,(0.01*RSUMM(3,I),I=ISTART+IADD,
+ IIEND+IADD)
CALL WINDIO(NULINE)
END IF
IADD = IADD + NIMG
10 CONTINUE
IF (IIEND.LT.NIMG) THEN
ISTART = ISTART + IWIDTH
GOTO 4
END IF
ISTART = 1
WRITE(IOUT,FMT=6020)
IF (ONLINE) WRITE(ITOUT,FMT=6020)
6020 FORMAT(/,/,1X,'YSCALE as a function of cycle for each image:')
IF (DISPMENU) THEN
LINE = ' '
CALL MXDWIO(LINE,1)
NULINE = .FALSE.
WRITE(IOLINE,FMT=6020)
CALL WINDIO(NULINE)
END IF
14 IIEND = ISTART + IWIDTH - 1
IIEND = MIN(IIEND,NIMG)
WRITE(IOUT,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
IF (ONLINE) WRITE(ITOUT,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
CALL WINDIO(NULINE)
END IF
IADD = 0
DO 20 ICYC = 1,NREPEAT+1
WRITE(IOUT,FMT=6024) ICYC,(RSUMM(2,I), I=ISTART+IADD,
+ IIEND+IADD)
IF (ONLINE) WRITE(ITOUT,FMT=6024) ICYC,
+ (RSUMM(2,I), I=ISTART+IADD,IIEND+IADD)
6024 FORMAT(1X,'Cycle',I2,3X,10F6.3)
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6024) ICYC,(RSUMM(2,I), I=ISTART+IADD,
+ IIEND+IADD)
CALL WINDIO(NULINE)
END IF
IADD = IADD + NIMG
20 CONTINUE
IF (IIEND.LT.NIMG) THEN
ISTART = ISTART + IWIDTH
GOTO 14
END IF
ISTART = 1
WRITE(IOUT,FMT=6030)
IF (ONLINE) WRITE(ITOUT,FMT=6030)
6030 FORMAT(/,/,1X,'Detector distance as a function of cycle',
+ ' for each image:')
IF (DISPMENU) THEN
LINE = ' '
CALL MXDWIO(LINE,1)
NULINE = .FALSE.
WRITE(IOLINE,FMT=6030)
CALL WINDIO(NULINE)
END IF
C
24 IIEND = ISTART + IWIDTH - 1
IIEND = MIN(IIEND,NIMG)
WRITE(IOUT,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
IF (ONLINE) WRITE(ITOUT,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6002) (ISUMM(1,I), I=ISTART,IIEND)
CALL WINDIO(NULINE)
END IF
IADD = 0
DO 30 ICYC = 1,NREPEAT+1
WRITE(IOUT,FMT=6034) ICYC,(0.01*ISUMM(4,I), I=ISTART+IADD,
+ IIEND+IADD)
IF (ONLINE) WRITE(ITOUT,FMT=6034) ICYC,
+ (0.01*ISUMM(4,I), I=ISTART+IADD,IIEND+IADD)
6034 FORMAT(1X,'Cycle',I2,3X,10F6.1)
IF (DISPMENU) THEN
NULINE = .FALSE.
WRITE(IOLINE,FMT=6034) ICYC,(0.01*ISUMM(4,I), I=ISTART+IADD,
+ IIEND+IADD)
CALL WINDIO(NULINE)
END IF
IADD = IADD + NIMG
30 CONTINUE
IF (IIEND.LT.NIMG) THEN
ISTART = ISTART + IWIDTH
GOTO 24
END IF
IFIRST = 1
IF (NEWPREF) IFIRST = 2
WRITE(IOUT,FMT=6040) ISUMM(1,1),(PRFSUM(I,IFIRST),I=1,3),
+ ISUMM(1,NLAST),(PRFSUM(I,NLAST),I=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6040) ISUMM(1,1),
+ (PRFSUM(I,IFIRST),I=1,3),ISUMM(1,NLAST),(PRFSUM(I,NLAST),I=1,3)
6040 FORMAT(//,1X,'Missets for first image (',I4,')',3F6.2,/,1X,
+ 'Missets for last image (',I4,')',3F6.2)
C
IF (DISPMENU) THEN
LINE = ' '
CALL MXDWIO(LINE,1)
NULINE = .TRUE.
WRITE(IOLINE,FMT=6040) ISUMM(1,1),(PRFSUM(I,IFIRST),I=1,3),
+ ISUMM(1,NLAST),(PRFSUM(I,NLAST),I=1,3)
CALL WINDIO(NULINE)
WRITE(IOLINE,FMT=6042)
6042 FORMAT(1X,'The current missets are for the last image to',
+ ' be processed.',/,1X,'If you want to integrate',
+ ' the data starting at the first image, you should',
+ /,1X,'reset the misseting angles.')
CALL WINDIO(NULINE)
C
LINE = 'Reset missets to those of the first image ? (Y)'
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
DO 50 I=1,3
DELPHI(I) = PRFSUM(I,IFIRST)
50 CONTINUE
END IF
C
C---- Close I/O window
C
CALL MXDCIO(1,0,0,0,0)
END IF
RETURN
END
C== PRUPDATE ==
SUBROUTINE PRUPDATE(LRAS,MASK,MASKREJ,IPROFL,PROFSUMS,WPROFSUMS,
+ NLOWPK)
C
C---- If using the weighted profiles, then after transferring the profile
C from array WPROFL to IPROFL, the sums in PROFSUMS must be re-evaluated
C because the profile values are now integer rather than real.
C
C Elements of PROFSUMS
C 1 = sum p*P p,q are pixel coords wrt centre of box
C 2 = sum q*P P is the profile value
C 3 = sum P summation is over peak pixels
C 4 = sum P*P
C
C NLOWPK Number of peak pixels with value less than 5% of peak value
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NLOWPK
C ..
C .. Array Arguments ..
INTEGER LRAS(5),MASK(MAXBOX),MASKREJ(NREJMAX),IPROFL(MAXBOX)
REAL PROFSUMS(4),WPROFSUMS(4)
C ..
C .. Local Scalars ..
REAL PRMIN,PRMAX,WPRIJ,SUMPP,SUMQP,SUMP,SUMPSQ,
+ WSUMPP,WSUMQP,WSUMP,WSUMPSQ,WSUMB
+
INTEGER HX,HY,IJ,P,Q,NXY,NXX,NYY,IOD,I,N,NBREJ,ISUMB
C ..
C .. Local arrays ..
INTEGER LMASK(MAXBOX)
C ..
C .. Intrinsic functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
C .. Equivalences ..
C
SAVE
C ..
C
C
NXX = LRAS(1)
NYY = LRAS(2)
NXY = NXX*NYY
HX = NXX/2
HY = NYY/2
C
C---- Set up mask which allows for rejected background points
C
C
DO 2 I = 1,NXY
LMASK(I) = MASK(I)
2 CONTINUE
C
NBREJ = MASKREJ(1)
DO 4 N = 1,NBREJ
IJ = MASKREJ(N+1)
LMASK(IJ) = 0
4 CONTINUE
C
C---- Now find average value of profile in the background
C
IJ = 0
N = 0
WSUMB = 0.0
DO 8 P = -HX,HX
DO 6 Q = -HY,HY
IJ = IJ + 1
C
C---- Form sums for whole box except rejected background pixels
C
IF (LMASK(IJ).LT.0) THEN
IOD = IPROFL(IJ)
WSUMB = WSUMB + IOD
N = N + 1
END IF
6 CONTINUE
8 CONTINUE
C
C
IF (N.NE.0) WSUMB = WSUMB/REAL(N)
ISUMB = NINT(WSUMB)
C WRITE(6,*),'Mean value over background pixels',ISUMB
C WRITE(6,*),'NUMBER OF BACKGROUND PIXELS',N
C
C---- Subtract this average value from all pixels
C
DO 9 I = 1,NXY
IPROFL(I) = IPROFL(I)
9 CONTINUE
C
C---- Set up mask where only rejected background pixels are flagged for
C rejection
C
C
DO 10 I = 1,NXY
LMASK(I) = 1
10 CONTINUE
C
NBREJ = MASKREJ(1)
DO 20 N = 1,NBREJ
IJ = MASKREJ(N+1)
LMASK(IJ) = 0
20 CONTINUE
C
IJ = 0
SUMPP = 0.
SUMQP = 0.
SUMP = 0.
SUMPSQ = 0.
WSUMPP = 0.
WSUMQP = 0.
WSUMP = 0.
WSUMPSQ = 0.
NLOWPK = 0
DO 40 P = -HX,HX
DO 30 Q = -HY,HY
IJ = IJ + 1
C
C---- Form sums for peak area whole box except rejected background pixels
C
IF (MASK(IJ).GT.0) THEN
IOD = IPROFL(IJ)
SUMP = SUMP + IOD
SUMPSQ = IOD*IOD + SUMPSQ
SUMPP = P*IOD + SUMPP
SUMQP = Q*IOD + SUMQP
C
C---- Count number of peak pixels with a profile value less than
C 5% of maximum value (10000)
C
IF (IOD.LT.500) NLOWPK = NLOWPK + 1
END IF
IF (LMASK(IJ).GT.0) THEN
IOD = IPROFL(IJ)
WSUMP = WSUMP + IOD
WSUMPSQ = IOD*IOD + WSUMPSQ
WSUMPP = P*IOD + WSUMPP
WSUMQP = Q*IOD + WSUMQP
END IF
30 CONTINUE
40 CONTINUE
C
PROFSUMS(1) = SUMPP
PROFSUMS(2) = SUMQP
PROFSUMS(3) = SUMP
PROFSUMS(4) = SUMPSQ
WPROFSUMS(1) = WSUMPP
WPROFSUMS(2) = WSUMQP
WPROFSUMS(3) = WSUMP
WPROFSUMS(4) = WSUMPSQ
C
RETURN
END
C== PRWEIGHT ==
SUBROUTINE PRWEIGHT(NVBOX,IPRNUM,XYR,XCV,YCV,WTPR)
C
C---- Determines the weights WTPR for the NVBOX contributing profiles for
C reflection with coordinates XYR. XCV,YCV are coordinates of the
C vertices.
C ..
C .. Scalar Arguments ..
INTEGER NVBOX
C ..
C .. Array Arguments ..
INTEGER IPRNUM(9)
REAL XYR(2),XCV(4),YCV(4),WTPR(9)
C ..
C .. Local Scalars ..
INTEGER IMISS,IV,I1,I2,I3,II1,MULT
REAL XR,YR,DELX4R,DELXR1,DELX3R,DELXR2,DELX41,DELX32,RX1,RX2,
+ RX3,RX4,YA,YB,DELYBA,DELYBR,DELYRA,RY1,RY2,WI1,WI2,WI3,RX,RY,
+ DELX21,DELY21,DELYR1,DELY31
C ..
C .. Local Arrays ..
INTEGER INDEX(3,4)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C
C ..
C .. Data statements
C
DATA INDEX/3,2,4,4,1,3,1,4,2,2,3,1/
XR = XYR(1)
YR = XYR(2)
IF (NVBOX.EQ.3) GOTO 20
IF (NVBOX.EQ.2) GOTO 40
IF (NVBOX.EQ.1) GOTO 60
C
C---- General case, all four profiles are real
C
DELX4R = XCV(4) - XR
DELXR1 = XR - XCV(1)
DELX3R = XCV(3) - XR
DELXR2 = XR - XCV(2)
DELX41 = XCV(4) - XCV(1)
DELX32 = XCV(3) - XCV(2)
C
C--- When one of the profiles is the central one, its coordinates are
C variable and can end up the same as the adjacent profile !
C
IF (ABS(DELX41).GT.0.01) THEN
RX1 = DELX4R/DELX41
RX2 = DELXR1/DELX41
ELSE
RX1 = 0.5
RX2 = 0.5
END IF
IF (ABS(DELX32).GT.0.01) THEN
RX3 = DELX3R/DELX32
RX4 = DELXR2/DELX32
ELSE
RX3 = 0.5
RX4 = 0.5
END IF
YA = YCV(1)*RX1 + YCV(4)*RX2
YB = YCV(2)*RX3+ YCV(3)*RX4
DELYBA = YB - YA
DELYBR = YB - YR
DELYRA = YR - YA
IF (ABS(DELYBA).GT.0.01) THEN
RY1 = DELYBR/DELYBA
RY2 = DELYRA/DELYBA
ELSE
RY1 = 0.5
RY2 = 0.5
END IF
WTPR(1) = RX1*RY1
WTPR(2) = RX3*RY2
WTPR(3) = RX4*RY2
WTPR(4) = RX2*RY1
RETURN
C
C---- Now deal with 3 profile case
C
C
C---- First find which profile is missing
C
20 IMISS = 0
DO 25 IV = 1,4
IF (IPRNUM(IV).LT.0) IMISS = IV
25 CONTINUE
C WRITE(6,*),'MISSING BOX',IMISS
IF (IMISS.EQ.0) THEN
WRITE(6,*)'ERROR, CANT FIND MISSING BOX'
CALL SHUTDOWN
END IF
C
C---- Set up for this box missing
C
I1 = INDEX(1,IMISS)
I2 = INDEX(2,IMISS)
I3 = INDEX(3,IMISS)
C WRITE(6,*),'I1,I2,I3',I1,I2,I3
DELXR1 = XR - XCV(I1)
DELX21 = XCV(I2) - XCV(I1)
DELYR1 = YR - YCV(I1)
DELY31 = YCV(I3) - YCV(I1)
RX = DELXR1/DELX21
RY = DELYR1/DELY31
WI1 = 1 - RX - RY
WI2 = RX
WI3 = RY
C
C---- Now given IMISS, need to know which number is WI1
C
WTPR(INDEX(1,IMISS)) = WI1
WTPR(INDEX(2,IMISS)) = WI2
WTPR(INDEX(3,IMISS)) = WI3
WTPR(IMISS) = 0.0
RETURN
C---- Now deal with 2 profile case
C Possible combinations are 1+2, 2+3, 3+4, 4+1. Find which we have
C I1 and I2 are the two vertices present
C
40 MULT = 1
DO 42 IV = 1,4
IF(IPRNUM(IV).GT.0) MULT = MULT*IV
WTPR(IV) = 0.0
42 CONTINUE
C
IF (MULT.EQ.2) THEN
I1 = 1
ELSE IF (MULT.EQ.6) THEN
I1 = 2
ELSE IF (MULT.EQ.12) THEN
I1 = 3
ELSE
I1 = 4
END IF
C
I2 = I1 + 1
IF (I2.GT.4) I2 = 1
II1 = MOD(I1,2) - 1
DELXR1 = XR - XCV(I1)
DELX21 = XCV(I2) - XCV(I1)
DELYR1 = YR - YCV(I1)
DELY21 = YCV(I2) - YCV(I1)
RX = 0.0
RY = 0.0
C
C---- Test II1 to avoid divide by zero
C
IF (II1.NE.0) THEN
RX = DELXR1/DELX21
ELSE
RY = DELYR1/DELY21
END IF
WTPR(I1) = 1.0 - RX - RY
WTPR(I2) = RX + RY
RETURN
C
C---- Now the one profile case...find which one is present
C
60 DO 62 IV = 1,4
IF (IPRNUM(IV).GT.0) THEN
WTPR(IV) = 1.0
ELSE
WTPR(IV) = 0.0
END IF
62 CONTINUE
END
C== PSITOPHI ==
C
C
C
SUBROUTINE PSITOPHI(PSI,PHI,PH)
C ===============================
C
C
C---- Convert PSIX,PSIY,PSIZ to PHIX,PHIY,PHIZ at angle PH
C Angles in degrees
C
C
C
C .. Scalar Arguments ..
REAL PH
C ..
C .. Array Arguments ..
REAL PHI(3),PSI(3)
C ..
C .. Local Scalars ..
REAL CP,CP1,CP2,CP3,CPX,CPY,CPZ,P11,P21,PHIX,PHIY,PHIZ,SP,SP1,SP2,
+ SP3,SPX,SPY,SPZ,DTOR
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN2,COS,SIN,ATAN
C ..
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
CPX = COS(DTOR*PSI(1))
CPY = COS(DTOR*PSI(2))
CPZ = COS(DTOR*PSI(3))
SPX = SIN(DTOR*PSI(1))
SPY = SIN(DTOR*PSI(2))
SPZ = SIN(DTOR*PSI(3))
CP = COS(DTOR*PH)
SP = SIN(DTOR*PH)
C
C---- Calculate phix
C
SP1 = CPY*SPX*CP + SPY*SP
CP1 = CPY*CPX
PHIX = ATAN2(SP1,CP1)
C
C---- Calculate phiy
C
SP2 = -CPY*SPX*SP + SPY*CP
CP2 = CPY*CPX/COS(PHIX)
PHIY = ATAN2(SP2,CP2)
C
C---- Calculate phiz
C
P11 = (CPZ*SPY*SPX-SPZ*CPX)*SP + CPZ*CPY*CP
P21 = (SPZ*SPY*SPX+CPZ*CPX)*SP + SPZ*CPY*CP
SP3 = -SP*P11 + CP*P21
CP3 = CP*P11 + SP*P21
PHIZ = ATAN2(SP3,CP3)
C
PHI(1) = PHIX/DTOR
PHI(2) = PHIY/DTOR
PHI(3) = PHIZ/DTOR
C
C
END
C== PSTART ==
SUBROUTINE PSTART(GENFILE,GTITLE,IDENT)
C =======================================
C
IMPLICIT NONE
C
C---- For precession films
C this subroutine is called once for each new generate file
C
C---- Opens generate file, reads header information
C in online, displays raster box and allows raster params
C to be changed.
C
C---- Sets up factor to convert generate file units to scanner units
C reads pmosflm.dat
C
C****** DEBUG(25) FOR THIS S/R ******
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
CHARACTER IDENT*40,GENFILE*200,GTITLE*80
C ..
C .. Local Scalars ..
REAL A1,ALP,B1,BET,C1,DSTMAX,GAM,OMEGA0,PI,RADEG,RMAX,RMIN
INTEGER HXS,HYS,I,IER,IH1,IH2,IK1,IK2,IL1,IL2,IPNT,IPREC,
+ ISYS,J,NC,NRX,NRY,NXS,NYS,TST,IDUMMY,IFAIL,
+ JJNREC,JIYLEN
CHARACTER MOSFILE*200,XTITLE*80,CBUFF*88
C ..
C .. Local Arrays ..
REAL AMAT(3,3),RBUF2(45),RBUFF(180)
INTEGER DMM(5),IBUF2(45),IBUFF(180),KSYS(3),MASK(MAXBOX),
+ IBMASK(MAXBOX)
CHARACTER IFDAT(3)*1
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL BELL,PLOTRAS,QOPEN,QREAD,QSEEK,
+ QWRITE,SETMASK
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,NINT,SIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/cconst8.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cconst8.h
C---- START of include file cconst8.h
C
C
C .. Arrays in Common /CCONST8/ ..
REAL CCOMA
INTEGER CCXA,CCYA,CBARA
C ..
C .. Common block /CCONST8/ ..
COMMON /CCONST8/CCOMA(8),CCXA(8),CCYA(8),CBARA(8)
C ..
C
C
C
C&&*&& end_include ../inc/cconst8.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (RBUFF,IBUFF), (IBUFF,CBUFF), (RBUF2,IBUF2)
SAVE
C ..
C .. Data statements ..
DATA IFDAT/'A ','B ','C '/
C ..
C
C---- Open generate file
C
C **************************
CALL QOPEN(IUNIT,GENFILE,'OLD')
CALL QMODE(IUNIT,0,IDUMMY)
C **************************
C
C---- Read generate file header
C
C **************************
CALL QREAD(IUNIT,IBUFF,720,IER)
C **************************
C
IPACKREC = 21
GTITLE = CBUFF(1:80)
IDENT = CBUFF(81:88)
WRITE (IOUT,FMT=6000) GTITLE(1:LENSTR(GTITLE)),IDENT
6000 FORMAT (1X,'Title from GENERATE FILE',/1X,A,/1X,'Crystal IDENTIF',
+ 'IER: ',A)
IF (ONLINE) WRITE (ITOUT,FMT=6000) GTITLE,IDENT
IPNT = 22
C
C
DO 20 J = 1,3
DO 10 I = 1,3
IPNT = IPNT + 1
AMAT(I,J) = RBUFF(IPNT)
10 CONTINUE
20 CONTINUE
C
C
XTOFD = RBUFF(35)
PCTOFD = XTOFD
RMIN = RBUFF(39)
RMAX = RBUFF(40)
NPACKS = IBUFF(41)
MINT = IBUFF(42)
ISYS = IBUFF(46)
KSYS(1) = IBUFF(47)
KSYS(2) = IBUFF(48)
KSYS(3) = IBUFF(49)
DSTMAX = RBUFF(50)
IRAS(1) = IBUFF(54)
IRAS(2) = IBUFF(55)
IRAS(3) = IBUFF(56)
IRAS(4) = IBUFF(57)
IRAS(5) = IBUFF(58)
RAST = REAL(IBUFF(59))
XLAMBDA = RBUFF(63)
IPREC = IBUFF(73)
IH1 = IBUFF(74)
IK1 = IBUFF(75)
IL1 = IBUFF(76)
IH2 = IBUFF(77)
IK2 = IBUFF(78)
IL2 = IBUFF(79)
A1 = RBUFF(80)
B1 = RBUFF(81)
C1 = RBUFF(82)
ALP = RBUFF(83)
BET = RBUFF(84)
GAM = RBUFF(85)
C
C---- First test that this is a precession generate file
C
IF (IPREC.NE.1) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6002)
6002 FORMAT (//1X,'***** FATAL ERROR *****',/1X,'The GENERATE File is',
+ ' not for PRECESSION PHOTOGRAPHS',/1X,'The file must be c',
+ 'reated using program PREGEN')
WRITE (IOUT,FMT=6002)
STOP
ELSE
C
C---- Print scanner unit
C SCNSZ is derived from the status word for the scanner
C and gives the scanner unit in multiples of 25 microns
C read measurement box parameters
C
WRITE (IOUT,FMT=6004) NINT(RAST)
6004 FORMAT (' Scanner unit:',I6,' MICRONS')
IF (ONLINE) WRITE (ITOUT,FMT=6004) NINT(RAST)
SCNSZ = RAST/25.0
C
C---- Store pixle size im mm (NOT microns)
C
RAST = RAST*0.001
C
C
C---- FACT is the factor used through-out the program to
C transform from generate-file units (10 micron) to scanner units.
C
FACT = 0.4/SCNSZ
C
C---- Get box parameters in scanner units
C if a raster card was present (newras=1) skip this
C
IF (NEWRAS.EQ.1) THEN
IPNT = 58
ELSE
IPNT = 53
C
C
DO 30 I = 1,5
IPNT = IPNT + 1
IRAS(I) = IBUFF(IPNT)
30 CONTINUE
C
C
NEWRAS = 0
END IF
C
C
IF (DEBUG(25)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6006) NPACKS,XTOFD,MINT,RAST,
+ IRAS,PCTOFD,XLAMBDA,IH1,IK1,IL1,IH2,IK2,IL2
6006 FORMAT (2X,'In PSTART NPACKS=',I5,' XTOFD=',I6,' MINT=',I4,' ',
+ 'RAST=',I3,/1X,'RASTER',5I3,/1X,'PCTOFD',F7.0,' XLAMBDA=',
+ F8.3,' H1,K1,L1',3I4,' H2,K2,L2',3I4)
WRITE (IOUT,FMT=6006) NPACKS,XTOFD,MINT,RAST,IRAS,PCTOFD,
+ XLAMBDA,IH1,IK1,IL1,IH2,IK2,IL2
END IF
C
C
40 CONTINUE
C
C---- Transform some of the box parameters to odd number
C of scanner units
C
HXS = NXS/2
HYS = NYS/2
NXS = HXS*2 + 1
NYS = HYS*2 + 1
C
C---- Print box parameters and read new ones
C draw shape of measurement box
C
C ******************
CALL SETMASK(MASK,IRAS)
CALL PLOTRAS(MASK,IRAS,IBMASK,NXS,NYS)
C **************************
C
WRITE (IOUT,FMT=6008)
6008 FORMAT (' NXS NYS NC NRX NRY ')
IF (ONLINE) WRITE (ITOUT,FMT=6008)
WRITE (IOUT,FMT=6010) IRAS
6010 FORMAT (1X,5I5,' ? (I5 Input to modify, to get 0 enter 99)')
C
C
IF (ONLINE) THEN
C
C ****
IF(LBELL)CALL BELL
C ****
C
WRITE (ITOUT,FMT=6010) IRAS
READ (ITIN,FMT=6012) DMM
6012 FORMAT (5I5)
TST = 0
C
C
DO 50 I = 1,5
C
C
IF (DMM(I).NE.0) THEN
NEWRAS = 1
TST = 1
C
C
IF (DMM(I).EQ.99) THEN
IRAS(I) = 0
ELSE
IRAS(I) = DMM(I)
END IF
END IF
50 CONTINUE
C
C
IF (TST.EQ.1) GO TO 40
ELSE
GO TO 70
END IF
C
C
C---- Update raster parameters on generate file
C
IF (NEWRAS.EQ.1) THEN
C
C *******************
CALL QSEEK(IUNIT,1,1,36)
C *******************
C
IPNT = 53
C
C
DO 60 I = 1,5
IPNT = IPNT + 1
IBUFF(IPNT) = IRAS(I)
60 CONTINUE
C
C ***********************
CALL QWRITE(IUNIT,IBUFF,720)
C ***********************
C
NEWRAS = 0
END IF
C
C
70 DTOFD = XTOFD
PI = 3.1415927
RADEG = 18000.0/PI
C
C---- Read constants from logical file 'pmosflm'
C
IFAIL = 1
C
C ***********************************
CALL CCPOPN(44,'PMOSFLMDAT',3,1,80,IFAIL)
c-vms open (unit=4,file='pmosflm.dat',status='old',err=80)
C ***********************************
C
IF (IFAIL.EQ.-1) GO TO 80
C
C---- Find true filename of constants file
C
INQUIRE (UNIT=44,NAME=MOSFILE)
READ (44,FMT=6014) XTITLE
6014 FORMAT (A)
WRITE (IOUT,FMT=6016) MOSFILE,XTITLE(1:LENSTR(XTITLE))
6016 FORMAT (/1X,'Title from MOSFLM Constants file ',A,/1X,A)
IF (ONLINE) WRITE (ITOUT,FMT=6016) MOSFILE,XTITLE
C
READ (44,FMT=*) MMDB,N1OD,BASEOD,G1OD,CURV
C
C---- Convert mmdb to 10 micron units, then halve it because
C it is used as half-width in the code (fidus)
C
MMDB = 100*MMDB/2
WRITE (IOUT,FMT=6018) BASEOD,G1OD,CURV,N1OD
6018 FORMAT (/10X,'Film characteristics',/' BASE O.D.=',F4.2,' GRANUL',
+ 'ARITY=',F4.1,' Non-linearity Factor=',F5.2,' N1OD=',I4)
IF (ONLINE) WRITE (ITOUT,FMT=6018) BASEOD,G1OD,CURV,N1OD
C
FDIST = 1.0/ (XTOFD*RADEG)
C
C---- ITWIST ITILT IBULGE not defined ERROR!!!!
C
cc?? twist = itwist*fdist
cc?? tilt = itilt*fdist
cc?? bulge = ibulge*fdist
C
C
READ (44,FMT=*) JJNREC,JIYLEN
C
C
NREC = JJNREC
IYLEN = JIYLEN
C
C
XTOFRA = 1.0
OMEGAF = 0.0
OMEGA0 = OMEGAF
COSOM0 = COS(OMEGA0)
SINOM0 = SIN(OMEGA0)
IF (ONLINE) WRITE (ITOUT,FMT=6020) NREC,IYLEN
6020 FORMAT (/1X,'Width of film scanned (PIXELS)',I6,/1X,'Length of e',
+ 'ach stripe (PIXELS)',I6)
C
C---- Set limits of scanning (used in gensort)
C
XSCMIN = 1
XSCMAX = NREC
C
C---- NWORD is number of 2-byte words in a strip of ods
C
IF (IMGP) THEN
NWORD = IYLEN
NBYTE = IYLEN/2
ELSE
NWORD = IYLEN/2
NBYTE = IYLEN
END IF
WRITE (IOUT,FMT=6020) NREC,IYLEN
C
C
IF (IYLEN.GT.IYLENGTH) THEN
NWRN = NWRN + 1
IF (ONLINE) WRITE (ITOUT,FMT=6022)
6022 FORMAT (//2X,'Stripes are too long to store, need to change size',
+ ' of array IJBA in /PEL/ ')
WRITE (IOUT,FMT=6022)
STOP
ELSE IF (NREC.GT.IXWDTH) THEN
NWRN = NWRN + 1
IF (ONLINE) WRITE (ITOUT,FMT=6024) NREC
6024 FORMAT (//2X,'Width of image is too large to work with image in ',
+ 'core',/1X,'Either use Keyword "NOCORE" or recompile with',
+ ' PARAMETER "IXWDTH" ge ',I6)
WRITE (IOUT,FMT=6024) NREC
STOP
ELSE
CLOSE (UNIT=44)
END IF
C
C
RETURN
C
C
80 IF (ONLINE) WRITE (ITOUT,FMT=6026)
6026 FORMAT (//1X,'**** ERROR ****',/1X,'MOSFLM Constants file does n',
+ 'ot exist')
NWRN = NWRN + 1
WRITE (IOUT,FMT=6026)
STOP
END IF
END
C== PSTOPH ==
C
C
SUBROUTINE PSTOPH(PSIX,PSIY,PSIZ,PHIX,PHIY,PHIZ,AVPHI)
C =======================================================
C
C
C---- Convert PSIX,PSIY,PSIZ to PHIX,PHIY,PHIZ
C Angles in degrees
C
C .. Scalar Arguments ..
REAL AVPHI,PHIX,PHIY,PHIZ,PSIX,PSIY,PSIZ
C ..
C .. Local Scalars ..
REAL CP,CP1,CP2,CP3,CPX,CPY,CPZ,P11,P21,SP,SP1,SP2,SP3,SPX,SPY,
+ SPZ,DTOR
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN2,COS,SIN
C ..
SAVE
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
CP1 = COS(DTOR*PSIX)
SP1 = SIN(DTOR*PSIX)
CP2 = COS(DTOR*PSIY)
SP2 = SIN(DTOR*PSIY)
CP3 = COS(DTOR*PSIZ)
SP3 = SIN(DTOR*PSIZ)
CP = COS(DTOR*AVPHI)
SP = SIN(DTOR*AVPHI)
C
C---- Calculate phix
C
SPX = CP2*SP1*CP + SP2*SP
CPX = CP2*CP1
PHIX = ATAN2(SPX,CPX)
C
C---- Calculate phiy
C
SPY = -CP2*SP1*SP + SP2*CP
CPY = CP2*CP1/COS(PHIX)
PHIY = ATAN2(SPY,CPY)
C
C---- Calculate phiz
C
P11 = (CP3*SP2*SP1-SP3*CP1)*SP + CP3*CP2*CP
P21 = (SP3*SP2*SP1+CP3*CP1)*SP + SP3*CP2*CP
SPZ = -SP*P11 + CP*P21
CPZ = CP*P11 + SP*P21
PHIZ = ATAN2(SPZ,CPZ)
C
PHIX = PHIX/DTOR
PHIY = PHIY/DTOR
PHIZ = PHIZ/DTOR
C
END
C
INTEGER FUNCTION PUTPXL(IPIXEL)
C ===============================
C
C Pack the full value IPIXEL into a number to be stored as an I*2
C which is returned. This is the opposite to INTPXL
C
IMPLICIT NONE
C
INTEGER IPIXEL
C
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
C
IF (IPIXEL.LE.32767) THEN
PUTPXL = IPIXEL
ELSE
IF ((MACHINE.EQ.'MAR ').OR.
+ (MACHINE.EQ.'FUJI').OR.
+ (MACHINE.EQ.'LMB').OR.
+ (MACHINE.EQ.'CCD1').OR.
+ (MACHINE.EQ.'CCD2').OR.
+ (MACHINE.EQ.'ADSC').OR.
+ (MACHINE.EQ.'SBC1').OR.
+ (MACHINE.EQ.'MARC').OR.
+ (MACHINE.EQ.'LIPS').OR.
+ (MACHINE.EQ.'JUPI').OR.
+ (MACHINE.EQ.'BRUK').OR.
+ (MACHINE.EQ.'UNK')) THEN
C
IPIXEL = -IPIXEL/8
C
C---- Check that this does not exceed 32767, if it does, reset to 32766
C
IF (ABS(IPIXEL).GT.32766) IPIXEL = -32766
ELSE IF (MACHINE.EQ.'RAXI') THEN
IF (MODEL.EQ.'RAXIS ') THEN
IPIXEL = IPIXEL/8 - 32768
IF (IPIXEL.GE.0) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
6000 FORMAT(1X,'*** summed pixel too large ***')
IPIXEL = -1
END IF
ELSE IF ((MODEL.EQ.'RAXISIV').OR.(MODEL.EQ.'RAXISV')) THEN
IPIXEL = IPIXEL/32 - 32768
IF (IPIXEL.GE.0) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
IPIXEL = -1
END IF
ELSE
WRITE(IOUT,FMT=6010) MODEL
IF (ONLINE) WRITE(ITOUT,FMT=6010) MODEL
6010 FORMAT(1X,'***** unknown model for RAXIS scanners:',A)
STOP
END IF
ELSE IF (MACHINE.EQ.'MD') THEN
C
C---- MD Offline scanners
C
IPIXEL = IPIXEL - 65536
ELSE IF (MACHINE.EQ.'DIP2') THEN
CHRP for Atsushi Nakagawa IF (MODEL.EQ.'12BIT') THEN
CHRP for Atsushi Nakagawa IPIXEL = -(IPIXEL-32768)/256 -1
IF (MODEL.EQ.'16BIT') THEN
IPIXEL = -(IPIXEL)/32 -1
ELSE IF (MODEL.EQ.'12BIT') THEN
IPIXEL = -(IPIXEL-32768)/256 -1
ELSE IF(MODEL.EQ.'16BITD') THEN
IPIXEL = -(IPIXEL)/32 -1
ELSE
CHRP for Atsushi Nakagawa IPIXEL = -(IPIXEL)/32 -1
IPIXEL = IPIXEL - 65536
END IF
C
C---- Check that this does not exceed 32767, if it does, reset to 32766
C
IF (ABS(IPIXEL).GT.32766) IPIXEL = -32766
ELSE
WRITE(IOUT,FMT=6002)
IF (ONLINE) WRITE(ITOUT,FMT=6002)
6002 FORMAT(1X,'Scanner type not recognised, cannot pack',
+ ' pixel values')
STOP
END IF
IF (ABS(IPIXEL).GT.32767) THEN
WRITE(6,*)'Illegal value for packed pixel', IPIXEL
STOP
END IF
PUTPXL = IPIXEL
END IF
RETURN
END
C== PWRGEN ==
SUBROUTINE PWRGEN(MODE,PROFILE)
C ===============================
C
C
C
C---- when using accumulated profiles, the refined camera
C constants must be written back to the generate file
C for each "A" film during the first pass, as this
C information is lost when the next "A" film is refined.
C also, when the intensities of the "A" film are written
C during the second pass, the camera constants must not be
C written back, because they will be the values for the
C last film processed during the first pass
C if MODE=-1 for nofid option. same as MODE 0, but camera
C constants for B and C films will be written to
C their special locations
C if MODE=0 both camera constants and intensities will be
C written (only used if not accumulating profiles).
C if MODE=1 only camera constants are written
C if MODE=2 only intensities are written
C if MODE=3 write camera constants for "B" or "C" films
C (only used with FINDCC option)
C if MODE.gt.3 write back camera constants for B and C films
C to their own location in header. used with NOFID
C option.
C
C writes out measured intensities to generate file
C sets all unmeasured spots explicitly as unmeasured
C
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE
LOGICAL PROFILE
C ..
C .. Local Scalars ..
INTEGER I,IBULGE,ICOL,ICOLN,IERR,IPNT,IPT,ITILT,ITWIST,K,NC,NEXTF,
+ NRX,NRY,NXS,NYS
LOGICAL BORCASA,MSRD
C ..
C .. Local Arrays ..
REAL RBUF2(45)
INTEGER IBUF2(45),IBUFF(180)
INTEGER*2 IBUF3(18)
C ..
C .. External Subroutines ..
EXTERNAL QBACK,QREAD,QSEEK,QWRITE
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (IBUF2(1),RBUF2(1))
C ..
SAVE
C
C
BORCASA = .FALSE.
C
C---- IPT is pointer for location of camera constants
C
IPT = 7
C
C
IF ((MODE.GE.3) .OR. (MODE.EQ.-1)) THEN
IF (BFILM) IPT = 23
IF (CFILM) IPT = 26
BORCASA = .TRUE.
C
C
IF (MODE.GE.3) THEN
MODE = 1
ELSE
MODE = 0
END IF
END IF
C
C---- If raster box has been updated in chkras when running
C online, or with a raster keyword when running in batch mode
C write it back now to generate file
C
IF (NEWRAS.NE.0) THEN
IF (DEBUG(28)) WRITE (ITOUT,FMT=6000) IRAS
C
C ***************************
CALL QSEEK(IUNIT,1,1,36)
CALL QREAD(IUNIT,IBUFF,720,IERR)
C ***************************
C
IPNT = 53
C
C
DO 10 I = 1,5
IPNT = IPNT + 1
IBUFF(IPNT) = IRAS(I)
10 CONTINUE
C
C ***********************
CALL QSEEK(IUNIT,1,1,36)
CALL QWRITE(IUNIT,IBUFF,720)
C ***********************
C
NEWRAS = 0
END IF
C
C---- If this is an a film, write refined film parameters back
C to generate file
C
IF (MODE.NE.2) THEN
IF (AFILM .OR. BORCASA) THEN
IF (DEBUG(28)) WRITE (ITOUT,FMT=6002) IPACKREC,IPACKHEAD
IF (DEBUG(28)) WRITE (ITOUT,FMT=6004) IPACKHEAD
C
C ***************************
CALL QSEEK(IUNIT,IPACKHEAD,1,36)
CALL QREAD(IUNIT,IBUF2,180,IERR)
C ***************************
C
ITILT = TILT/FDIST
ITWIST = TWIST/FDIST
IBULGE = BULGE/FDIST
IBUF2(IPT) = CCX
IBUF2(IPT+1) = CCY
RBUF2(IPT+2) = PSIPREC
C
C---- Only write next params for A film
C
IF (AFILM) THEN
IBUF2(12) = ITILT
IBUF2(13) = ITWIST
IBUF2(14) = IBULGE
RBUF2(15) = YSCAL
RBUF2(19) = D1
RBUF2(20) = D2
RBUF2(21) = PHIPREC
RBUF2(22) = PSIPREC
END IF
C
C ***************************
CALL QSEEK(IUNIT,IPACKHEAD,1,36)
CALL QWRITE(IUNIT,IBUF2,180)
C ***************************
C
END IF
END IF
C
C---- NOTE: 5 records in pack header
C
IPACKREC = IPACKHEAD + 5
C
C
IF (MODE.EQ.1) THEN
C
C---- Reposition generate file at end of this pack so that
C the next pack can be found in "findpack"
C
IPACKREC = IPACKREC + TOSPT
C
C **************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C **************************
C
ELSE
C
C---- Position generate file at start of reflection records
C
C **************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C **************************
C
C
C---- Loop over reflections, writing out measured intensities
C and setting unmeasured reflections to -9999,-9999
C
IF (AFILM) THEN
ICOL = 7
ELSE IF (BFILM) THEN
ICOL = 9
ELSE
ICOL = 11
END IF
C
C
NEXTF = FILM + 1
C
C
DO 30 I = 1,TOSPT
C
C **************************
CALL QREAD(IUNIT,IBUF3,36,IERR)
C **************************
C
C---- Check if this reflection was measured, flag is set in gensort
C
IF (DEBUG(28) .AND. (I.LT.20)) WRITE (ITOUT,FMT=6006) I,
+ IGFLAG(I), (IBUF3(K),K=1,18)
MSRD = (IGFLAG(I).NE.0)
IBUF3(ICOL) = -9999
IBUF3(ICOL+1) = -9999
IBUF3(ICOL+6) = -9999
IBUF3(ICOL+7) = -9999
C
C
IF (MSRD) THEN
IBUF3(ICOL) = INTG(I)
IBUF3(ICOL+1) = ISDG(I)
C
C---- Now profile values if profile fitting used
C
IF (PROFILE) THEN
IBUF3(ICOL+6) = IPRO(I)
IBUF3(ICOL+7) = ISDPRO(I)
END IF
END IF
C
C---- Set int,isd for succeeding packs to -9999,-9999 in case
C they have been measured previously
C
IF (.NOT.CFILM) THEN
C
C
DO 20 K = NEXTF,3
ICOLN = 2*K + 5
IBUF3(ICOLN) = -9999
IBUF3(ICOLN+1) = -9999
IBUF3(ICOLN+6) = -9999
IBUF3(ICOLN+7) = -9999
20 CONTINUE
END IF
C
C **********************
CALL QBACK(IUNIT,36)
CALL QWRITE(IUNIT,IBUF3,36)
C **********************
C
IF (DEBUG(28) .AND. (I.LT.20)) WRITE (ITOUT,FMT=6006) I,
+ IGFLAG(I), (IBUF3(K),K=1,18)
30 CONTINUE
C
C
IPACKREC = IPACKREC + TOSPT
END IF
C
C---- Format statements
C
6000 FORMAT (/2X,'PWRGEN, Writing back new Raster Params',5I4)
6002 FORMAT (/1X,'Current IPACKREC ',I6,' IPACKHEAD',I6)
6004 FORMAT (/1X,'In PWRGEN, Writing Pack Header back to record',I5)
6006 FORMAT (1X,'REFLECTION',I4,' FLAG',I2,' DATA',3I4,I8,14I5)
C
C
END
C== PWRITE ==
C
C
C
SUBROUTINE PWRITE(IA,IB,L,IU)
C =============================
C
C
C
C
C .. Scalar Arguments ..
INTEGER IU,L
C ..
C .. Array Arguments ..
INTEGER*2 IA(12),IB(L)
C ..
C
C
WRITE (IU) L,IA
WRITE (IU) IB
C
C
END
C
C
C
SUBROUTINE PX2XYC(XC, YC, IX1, IY1)
C ===================================
C
C convert pixel coordinate IY1, IX1 to scanner coordinate xc, yc (mm)
C ie just multiply by pixel size
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
REAL XC, YC
INTEGER IY1, IX1
C
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C
C
YC = FLOAT(IY1) * RAST/YSCAL
XC = FLOAT(IX1) * RAST
RETURN
END
C
C
C
SUBROUTINE PX2XYCD(XC, YC, IX1, IY1)
C ===================================
C
C convert pixel coordinate IY1, IX1 to scanner coordinate xc, yc (*10mm)
C ie just multiply by pixel size
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
double precision XC, YC
INTEGER IY1, IX1
C
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C
C
rast = 0.15
yscal=1.00
YC = FLOAT(IY1) * RAST/YSCAL
XC = FLOAT(IX1) * RAST
RETURN
END
C
C
SUBROUTINE PXTOMM(XPIX, YPIX, XFILM, YFILM)
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C Convert image pixel coordinates (XPIX,YPIX) to millimeters.
C relative to the direct beam position
C Assumes ITILT,TWIST zero (otherwise maths is intractable !)
C
C
C XPIX, YPIX Image coordinates in pixels
C XFILM, YFILM Predicted coordinates in millimeters
C
C Modified to deal with swung out detectors 7/7/94. Need XCEN0,YCEN0
C rather than XCEN,YCEN
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
REAL XPIX,YPIX,XFILM, YFILM
REAL XMID,YMID,PSI,CPSI,SPSI,R1,R2,R3
C WRITE(6,*),'Input pixels',XPIX,YPIX
C WRITE(6,*),'XCEN0,YCEN0',XCEN0,YCEN0
C WRITE(6,*),'Cos(omega),sin(omega)',COSOM0,SINOM0
C
C---- XMID, YMID are pixel coordinates of centre of image, needed
C for distortions ROFF and TOFF
C
XMID = 0.5*REAL(NREC)
YMID = 0.5*REAL(IYLEN)
C
C---- PSI is the angle between a line joining the centre of rotation
C of the spiral scan to the spot and the scanner X axis (horizontal
C for Mar scanner).
C The centre of rotation is assumed to be the centre of the
C digitised image. The direct beam position cannot be used as it is
C not correct for an offset detector.
C
IF((XPIX-XMID).NE.0)THEN
PSI = ATAN2(YPIX-YMID,XPIX-XMID)
ELSE
PSI = ATAN(1.0)*2.0
ENDIF
CPSI = COS(PSI)
SPSI = SIN(PSI)
C---- FACT here converts back to pixels
R1 = FACT*(XCEN0 - TOFF*SPSI + ROFF*CPSI)*YSCAL
R2 = FACT*(YCEN0 + TOFF*CPSI + ROFF*SPSI)
R3 = XTOFRA*YSCAL
IF (R3.EQ.0.0) RETURN
XFILM = (XPIX*YSCAL*COSOM0+YPIX*SINOM0) - R1*COSOM0 - R2*SINOM0
C
C---- RAST converts back to mm
C
XFILM = RAST*XFILM/R3
YFILM = (YPIX*COSOM0 - XPIX*YSCAL*SINOM0) + R1*SINOM0 - R2*COSOM0
YFILM = (RAST/YSCAL)*YFILM/R3
C WRITE(6,*),'Output coords',XFILM,YFILM
RETURN
END
C== PXYCALC ==
C
C
C
SUBROUTINE PXYCALC(XC,YC,AN,AM)
C ==============================
C
C
C---- subroutine to calculate x and y
C
C Converts generate file values N,M (multiples of basis
C vectors D1,D2) to XC,YC 10micron units in the scanner
C coordinate frame, with respect to the lower left corner
C of the film (not the middle !).
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
C .. Scalar Arguments ..
REAL AM,AN,XC,YC
C ..
C .. Local Scalars ..
REAL CPHI,CPSI,DR,PI,SCALE,SPHI,SPSI
C ..
C .. Intrinsic Functions ..
INTRINSIC ATAN,COS,SIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C
C
SAVE
C ..
C
C
PI = ATAN(1.0)*4.0
DR = PI/180.0
CPHI = COS(PHIPREC*DR)
SPHI = SIN(PHIPREC*DR)
CPSI = COS(PSIPREC*DR)
SPSI = SIN(PSIPREC*DR)
C
C---- Factor 0.1 arises because AN,AM are stored as 10*N, 10*M
C
SCALE = 0.1*PCTOFD*XLAMBDA
XC = SCALE*CPSI* (AM*D2*CPHI+AN*D1) + XCEN - SCALE*SPSI*AM*D2*SPHI
YC = SCALE*SPSI* (AM*D2*CPHI+AN*D1) + YCEN + SCALE*CPSI*AM*D2*SPHI
C
C
END
C== QUAD2 ==
C
C
C
SUBROUTINE QUAD2(NR,A,B,C,V)
C ============================
C
C
C---- Solves for v in quadratic of form:
C A*V**2+2*B*V+C = 0
C
C
C
C
C
C .. Scalar Arguments ..
REAL A,B,C
INTEGER NR
C ..
C .. Array Arguments ..
REAL V(2)
C ..
C .. Local Scalars ..
REAL D
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT
C ..
C
C
NR = 0
C
C
IF (A.NE.0.0) THEN
D = B*B - A*C
IF (D) 30,10,20
10 NR = 1
V(1) = -B/A
GO TO 30
20 NR = 2
D = SQRT(D)
V(1) = (-B+D)/A
V(2) = (-B-D)/A
ELSE IF (B.NE.0.0) THEN
NR = 1
V(1) = -0.5*C/B
END IF
C
C
30 RETURN
C
C
END
C== QUICKINT ==
C
C
C
SUBROUTINE QUICKINT(OD,NXY,LISTPIX,PKRATIO,JDUMP)
C =============================================
C
C---- Rapid evaluation of signal to noise in spot.
C Find smallest pixel value (above zero), take this as
C the background and calculate expected noise level based
C on gain of detector. Use 9 peak pixels stored in LISTPIX
C to get estimate of spot intensity, taking true background to
C be 2.5*sigma above the lowest value
C
C Algorithm changed 20/8/92 to deal better with cases where adjacent
C spots intrude into background region.
C
C
C
C
C
C .. Scalar Arguments ..
REAL PKRATIO
INTEGER JDUMP,NXY
C ..
C .. Array Arguments ..
INTEGER LISTPIX(9),OD(*)
C ..
C .. Local Scalars ..
REAL BG,PK,RMSBG,SUMPK
INTEGER I,IJ,IOD,MINOD
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT,REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C
C
SAVE
C ..
C
C
C---- Find smallest non-zero pixel and say this is background
C
MINOD = 999999
DO 10 I = 1,NXY
IOD = OD(I)
IF ((IOD.GT.NULLPIX).AND.(IOD.LT.MINOD)) MINOD = IOD
10 CONTINUE
C
C
BG = REAL(MINOD)
RMSBG = SQRT(GAIN*BG)
BG = BG + 2.5*RMSBG
C
SUMPK = 0.0
C
C
DO 20 I = 1,9
IJ = LISTPIX(I)
SUMPK = OD(IJ) + SUMPK
20 CONTINUE
C
C
PK = SUMPK/9.0 - BG
PKRATIO = 0.0
IF (RMSBG.NE.0.0) PKRATIO = PK/RMSBG
C
C
IF (DUMP(1).AND.(I/NDUMP)*NDUMP.EQ.I.AND.JDUMP.LE.MXDUMP)THEN
WRITE (IOUT,FMT=6000) BG,PK,RMSBG
IF (ONLINE) WRITE (ITOUT,FMT=6000) BG,PK,RMSBG
END IF
C
C---- Format statements
C
6000 FORMAT (1X,'IN QUICKINT BG=',F5.1,' PK=',F5.1,' RMSBG=',F5.1)
C
C
END
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE RADBG(MODE,LPRNT,SIGAVG,IERR)
C ========================================
C
IMPLICIT NONE
C
C
C
C---- This subroutine calculates a radial background from rmin to rmax
C and returns BGOD containing the background values.
C
C MODE = 0 Determine background and find spots.
C = 1 Don't repeat background determination, just reset using
C new threshold
C = 2 Don't repeat spot search, just apply new limits
C = 10 Prelim search to determine best threshold, separation
C and raster box size
C
C LPRNT = TRUE Print radial background and stats on found spots
C FALSE No printing
C
C SIGAVG Average value of sigma in background
C
C IERR = 0 No error
C ne 0 Error in finding background in stripe IERR
C
C DEBUG(61)
C
C---- convert mm dimensions to pixels
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE,IERR
REAL SIGAVG
LOGICAL LPRNT
C ..
C .. Local Scalars ..
INTEGER I,I1,I2,II,IRMAX,IRMIN,IXCEN,IYCEN,J,N,NBACK,NLI,NOFF,
+ NPT,NRJ,NRJLAST,SUM,IYOFF,ISTEP,IIMIN,IST,IEND,ITOP,IBOT
LOGICAL FIRST
REAL DEL
CHARACTER LINE*80
C ..
C .. Local Arrays ..
REAL RAD(IXWDTH),SIGAV(IXWDTH)
INTEGER AV(IXWDTH),IBGAV(IXWDTH),IS(NPIXBG),ISIGBGAV(IXWDTH),
+ NREJ(IXWDTH),NREJAV(IXWDTH),PIX(NPIXBG)
C ..
C .. External Subroutines ..
EXTERNAL RDBLK,CBYTE,SORTUP4,DSPBGD,MXDWIO
C ..
C .. Intrinsic Functions ..
INTRINSIC MIN,NINT,REAL,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C ..
SAVE
C
C
IERR = 0
IXCEN = 0.01*XCEN/RAST
IYCEN = 0.01*YCEN/RAST
IF (MODE.GE.10) THEN
IRMIN = RMINSRCH/RAST
IRMAX = RMAXSRCH/RAST
ELSE
IRMIN = RMINSP/RAST
IRMAX = RMAXSP/RAST
END IF
IF (IRMIN.EQ.0) IRMIN = SIGN(1,IRMIN)
ISTEP = 1
IF (IRMAX.LT.0) ISTEP = -1
C
C---- Simply reset threshold if only THRESH has changed
C
IF ((MODE.GT.0).AND.(MODE.LT.10)) THEN
DO 2 I = IXCEN + IRMIN,IXCEN + IRMAX, ISTEP
II = ABS(I - IXCEN)
BGOD(II) = NINT((SIGAV(II)*THRESH)+AV(II))
2 CONTINUE
RETURN
END IF
C
C---- Radial background calculation for image plates
C
C Background calculated from NPIXBG pixels in strips in the area
C from ixcen+rmin to ixcen+rmax
C
NOFF = NPIXBG/2
IYOFF = YOFFSET/RAST
C
C---- For tiled detectors, check that the background strip does not overlap
C the gap between tiles
C
IST = IYCEN - NOFF + IYOFF
IEND = IYCEN + NOFF + IYOFF
DO 6 I = 1,NTILEY-1
ITOP = IEND + TILEWY(I)/2 + 1
IBOT = IST - TILEWY(I)/2 - 1
IF ((TILEY(I).GE.IBOT).AND.(TILEY(I).LE.ITOP)) THEN
C
C---- Strip lies within gap, apply offset
C
IYOFF = IYOFF + NPIXBG + 2*TILEWY(I) + 2
YOFFSET = YOFFSET + (NPIXBG+TILEWY(I)+ 2)*RAST
WRITE(IOUT,FMT=6024) NPIXBG*RAST
IF (ONLINE) WRITE(ITOUT,FMT=6024) NPIXBG*RAST
6024 FORMAT(/,1X,'Background strip overlaps gap between detector',
+ ' tiles, so YOFFSET changed to',F6.1,'mm')
IF (WINOPEN) THEN
WRITE(LINE,6026)
6026 FORMAT(1X,'Background strip offset to avoid gap ',
+ 'between tiles.')
CALL MXDWIO(LINE, 1)
END IF
C
C---- Re-display background box
C
IF(WINOPEN)CALL DSPBGD
END IF
6 CONTINUE
C
IF (LPRNT) WRITE (IOUT,FMT=6000) NPIXBG,YOFFSET
IF (ONLINE.AND.LPRNT) WRITE (ITOUT,FMT=6000) NPIXBG,YOFFSET
6000 FORMAT (1X,'Calculating radial background..... ',/,1X,'The ',
+ 'background is radial along the X (slow) direction',
+ /,1X,'The average of',I4,' pixels, excluding outliers,',
+ ' is used',/,1X,'The scan is offset by',F4.1,'mm ',
+ 'from the image centre in Y to avoid any',/,1X,
+ 'backstop shadow')
C
C---- Loop over strips
C
IF (DEBUG(61)) THEN
WRITE(IOUT,FMT=6022) MODE,IRMIN,IRMAX,IXCEN,IYCEN,NOFF,
+ IYOFF
IF (ONLINE) WRITE(ITOUT,FMT=6022) MODE,IRMIN,IRMAX,IXCEN,
+ IYCEN,NOFF,IYOFF
6022 FORMAT(1X,'Subroutine radbg',/,1X,'MODE',I3,' IRMIN,IRMAX',2I6,
+ ' IXCEN,IYCEN (Pixels)',2I6,' NOFF,IYOFF',2I4)
END IF
C
C---- Zero BGOD
C
DO 4 I = 1,IXWDTH
BGOD(I) = 0.0
4 CONTINUE
IIMIN = 10000
DO 50 I = IXCEN + IRMIN,IXCEN + IRMAX, ISTEP
II = ABS(I - IXCEN)
IIMIN = MIN(IIMIN,II)
IF (II.GT.IXWDTH) THEN
IF (LPRNT) WRITE(IOUT,FMT=6001) IXWDTH
IF (ONLINE.AND.LPRNT) WRITE(ITOUT,FMT=6001) IXWDTH
6001 FORMAT(1X,'**** ERROR *****',/,1X,'Array bounds error for',
+ ' arrays holding radial background in subroutine RADBG',/,
+ 'Current array size is ',I5,' set by parameter IXWDTH')
STOP
END IF
C
C---- test limits of I
C
IF ((I.LT.1) .OR. (I.GT.NREC)) GO TO 50
C
IF (DEBUG(61)) THEN
WRITE(IOUT,FMT=6020) I
IF (ONLINE) WRITE(ITOUT,FMT=6020) I
6020 FORMAT(1X,'Reading record',I5)
END IF
C ********
CALL RDBLK(I)
C ********
C
FIRST = .TRUE.
N = 0
SUM = 0
NRJ = 0
10 CONTINUE
C
C---- Loop over 51 pixels
C
DO 20 J = IYCEN - NOFF + IYOFF,IYCEN + NOFF + IYOFF
C
C *************
CALL CBYTE(J)
CAL CALL GETOD(J,IBA)
C *************
C
IF (FIRST) THEN
N = N + 1
PIX(N) = IBA
ELSE
Cal if (iba.le.(av(ii)+sigav(ii)*2))then
IF ((IBA.LE.(AV(II)+SIGAV(II)*1.5)).AND.
+ (IBA.GT.NULLPIX)) THEN
C
C---- Check if too big, ie probably spot
C
SUM = SUM + IBA
N = N + 1
ELSE
NRJ = NRJ + 1
END IF
END IF
20 CONTINUE
C
C
IF (FIRST) THEN
C
C---- Sort pixel values into ascending order
C
C ********************
CALL SORTUP4(NPIXBG,PIX,IS)
C ********************
C
C---- Set the background to the mean of the NPIXBG/3 smallest values,
C excluding values less than NULLPIX
C
NBACK = 0
SUM = 0.0
C
C
DO 30 J = 1,NPIXBG
IBA = PIX(IS(J))
IF (IBA.LE.NULLPIX) GO TO 30
NBACK = NBACK + 1
SUM = SUM + IBA
IF (NBACK.GE.NPIXBG/3) GO TO 40
30 CONTINUE
C
C
IF (LPRNT) WRITE (IOUT,FMT=6002) NPIXBG/3,NULLPIX,II*RAST
IF (ONLINE.AND.LPRNT) WRITE (ITOUT,FMT=6002) NPIXBG/3,NULLPIX,
+ II*RAST
6002 FORMAT (1X,'** WARNING **',/1X,'Less than',I3,' pixels with',
+ ' values greater than',I5,' (keyword NULLPIX) at a ',
+ 'radius of',F6.2,'mm')
CAL IERR = II
CAL RETURN
IF (NBACK.EQ.0) THEN
SUM = 1.0
NBACK = 1
END IF
C
40 AV(II) = SUM/NBACK
ELSE
IF (N.EQ.0) THEN
C
C---- When no accepted pixels, set AV to value from previous stripe
C
IF (II.GT.1) AV(II) = AV(II-1)
ELSE
C
C---- Average background
C
AV(II) = SUM/N
END IF
END IF
DEL = (REAL(AV(II))-IDIVIDE)
IF (DEL.LE.0) DEL = 1.0
SIGAV(II) = SQRT(GAIN*DEL)
SIGAV(II) = MAX(SIGAV(II),1.0)
C
C WRITE(6,*),'ii,av,sig',ii,av(ii),sigav(ii)
C
C
IF (FIRST) THEN
C WRITE(IOUT,2222) PIX
6004 FORMAT (1X,11I6)
FIRST = .FALSE.
SUM = 0
N = 0
NRJ = 0
NRJLAST = 0
GO TO 10
ELSE
C
C---- At end, calculate threshold for plot
C
IF (NRJ.EQ.NRJLAST) THEN
C
C WRITE(6,*),'ii, final av,sig',ii,av(ii),sigav(ii)
C
BGOD(II) = NINT((SIGAV(II)*THRESH)+AV(II))
NREJ(II) = NRJ
C WRITE(6,*),'II,THRESH,NREJ',ii,bgod(ii),nrej(ii)
ELSE
SUM = 0.0
N = 0
NRJLAST = NRJ
NRJ = 0
GO TO 10
END IF
END IF
50 CONTINUE
IF (LPRNT) WRITE (IOUT,FMT=6006)
IF (ONLINE.AND.LPRNT) WRITE (ITOUT,FMT=6006)
6006 FORMAT (1X,'Radial Background calculation complete')
C
DO 52 I = 1,IIMIN-1
BGOD(I) = BGOD(IIMIN)
52 CONTINUE
C
C IF (PRINT) THEN
C
C---- Find average over 4 pixels (0.6mm) at a time
C
NPT = 0
SIGAVG = 0.0
C
C---- Loop over strips
C
ISTEP = 4
IF (IRMAX.LT.0) ISTEP = -4
DO 60 I = IXCEN + IRMIN,IXCEN + IRMAX,ISTEP
NPT = NPT + 1
II = ABS(I - IXCEN)
IBGAV(NPT) = (AV(II+1)+AV(II)+AV(II+2)+AV(II+3))*0.25
ISIGBGAV(NPT) = (SIGAV(II+1)+SIGAV(II)+SIGAV(II+2)+SIGAV(II+3))*
+ 0.25
SIGAVG = SIGAVG + ISIGBGAV(NPT)
ISIGBGAV(NPT) = MAX(ISIGBGAV(NPT),2)
RAD(NPT) = II*RAST
NREJAV(NPT) = (NREJ(II+1)+NREJ(II)+NREJ(II+2)+NREJ(II+3))*0.25
60 CONTINUE
C
IF (NPT.GT.0) SIGAVG = SIGAVG/NPT
C
NLI = NPT/12 + 1
I1 = -11
C
C
DO 70 I = 1,NLI
I1 = I1 + 12
I2 = I1 + 11
I2 = MIN(I2,NPT)
IF (LPRNT) WRITE (IOUT,FMT=6008) (RAD(J),J=I1,I2)
IF (LPRNT) WRITE (IOUT,FMT=6010) (IBGAV(J),J=I1,I2)
IF (LPRNT) WRITE (IOUT,FMT=6012) (ISIGBGAV(J),J=I1,I2)
IF (LPRNT) WRITE (IOUT,FMT=6014) (NREJAV(J),J=I1,I2)
IF (ONLINE.AND.LPRNT) THEN
WRITE (ITOUT,FMT=6008) (RAD(J),J=I1,I2)
WRITE (ITOUT,FMT=6010) (IBGAV(J),J=I1,I2)
WRITE (ITOUT,FMT=6012) (ISIGBGAV(J),J=I1,I2)
WRITE (ITOUT,FMT=6014) (NREJAV(J),J=I1,I2)
END IF
70 CONTINUE
C
C
6008 FORMAT (1X,'RADIUS',12F6.1)
6010 FORMAT (1X,'BACKG ',12I6)
6012 FORMAT (1X,'SIGMA ',12I6)
6014 FORMAT (1X,'NREJ ',12I6)
C
C
RETURN
END
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE RADBGY(MODE,LPRNT,SIGAVG,IERR)
C ======================================
C
IMPLICIT NONE
C
C
C
C---- This subroutine calculates a radial background from rmin to rmax
C in the Y (fastest changing) direction and returns BGOD containing
C the background values.
C
C
C MODE = 0 Determine background and find spots.
C = 1 Don't repeat background determination, just reset using
C new threshold
C = 2 Don't repeat spot search, just apply new limits
C = 10 Prelim search to determine best threshold, separation
C and raster box size. Onl affects setting of radii for search.
C
C LPRNT = TRUE Print radial background and stats on found spots
C FALSE No printing
C
C SIGAVG Average value of sigma in background
C
C IERR = 0 No error
C gt 0 Error in finding background in stripe IERR
C eq -1 Error on return from RDROW
C
C---- convert mm dimensions to pixels
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE,IERR
REAL SIGAVG
LOGICAL LPRNT
C ..
C .. Local Scalars ..
INTEGER I,I1,I2,II,IRMAX,IRMIN,IXCEN,IYCEN,J,N,NBACK,NLI,NOFF,
+ NPT,NRJ,NRJLAST,SUM,IXOFF,IXST,ISTEP,IIMIN,
+ IST,IEND,ITOP,IBOT
LOGICAL FIRST,LLPRNT
REAL DEL
CHARACTER LINE*80
C ..
C .. Local Arrays ..
REAL RAD(IXWDTH),SIGAV(IXWDTH)
INTEGER AV(IXWDTH),IBGAV(IXWDTH),IS(NPIXBG),ISIGBGAV(IXWDTH),
+ NREJ(IXWDTH),NREJAV(IXWDTH),PIX(NPIXBG)
INTEGER*2 IVAL(IXWDTH)
C ..
C .. External Subroutines ..
EXTERNAL RDROW,SORTUP4,DSPBGD,MXDWIO
C ..
C .. Intrinsic Functions ..
INTRINSIC MIN,NINT,REAL,SQRT
C ..
C .. External Functions ..
INTEGER INTPXL
EXTERNAL INTPXL
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C ..
SAVE
C
C
IERR = 0
LLPRNT = (LPRNT.OR.DEBUG(61))
IXCEN = 0.01*XCEN/RAST
IYCEN = 0.01*YCEN/RAST
IF (MODE.GE.10) THEN
IRMIN = RMINSRCH/RAST
IRMAX = RMAXSRCH/RAST
ELSE
IRMIN = RMINSP/RAST
IRMAX = RMAXSP/RAST
END IF
IF (IRMIN.EQ.0) IRMIN = SIGN(1,IRMIN)
ISTEP = 1
IF (IRMAX.LT.0) ISTEP = -1
C
C---- Simply reset threshold if only THRESH has changed
C
IF ((MODE.GT.0).AND.(MODE.LT.10)) THEN
DO 2 I = IYCEN + IRMIN,IYCEN + IRMAX,ISTEP
II = ABS(I - IYCEN)
BGOD(II) = NINT((SIGAV(II)*THRESH)+AV(II))
2 CONTINUE
RETURN
END IF
C
C---- Radial background calculation for image plates
C
NOFF = NPIXBG/2
IXOFF = XOFFSET/RAST
C
C---- For tiled detectors, check that the background strip does not overlap
C the gap between tiles
C
IST = IYCEN - NOFF + IXOFF
IEND = IYCEN + NOFF + IXOFF
DO 6 I = 1,NTILEX-1
ITOP = IEND + TILEWX(I)/2 + 1
IBOT = IST - TILEWX(I)/2 - 1
IF ((TILEX(I).GE.IBOT).AND.(TILEX(I).LE.ITOP)) THEN
C
C---- Strip lies within gap, apply offset
C
IXOFF = IXOFF + NPIXBG + 2*TILEWX(I) + 2
XOFFSET = XOFFSET + (NPIXBG + 2*TILEWX(I)+ 2)*RAST
WRITE(IOUT,FMT=6024) NPIXBG*RAST
IF (ONLINE) WRITE(ITOUT,FMT=6024) NPIXBG*RAST
6024 FORMAT(/,1X,'Background strip overlaps gap between detector',
+ ' tiles, so XOFFSET changed to',F6.1,'mm')
IF (WINOPEN) THEN
WRITE(LINE,6026)
6026 FORMAT(1X,'Background strip offset to avoid gap ',
+ 'between tiles.')
CALL MXDWIO(LINE, 1)
END IF
C
C---- Re-display background box
C
IF(WINOPEN)CALL DSPBGD
END IF
6 CONTINUE
C Background calculated from NPIXBG pixels in strips in the area
C from iycen+rmin to iycen+rmax
C
IF (LLPRNT) WRITE (IOUT,FMT=6000) NPIXBG,XOFFSET
IF (ONLINE.AND.LLPRNT) WRITE (ITOUT,FMT=6000) NPIXBG,XOFFSET
6000 FORMAT (1X,'Calculating radial background',/,1X,'The ',
+ 'background is radial along the Y (fast) direction',
+ /,1X,'The average of',I4,' pixels, excluding outliers,',
+ ' is used',/,1X,'The scan is offset by',F4.1,'mm ',
+ 'from the image centre in X')
C
IXST = IXCEN + IXOFF - NOFF
IF (DEBUG(61)) THEN
WRITE(IOUT,FMT=6022) MODE,IRMIN,IRMAX,IXCEN,IYCEN,NOFF,IXOFF,
+ THRESH
IF (ONLINE) WRITE(ITOUT,FMT=6022) MODE,IRMIN,IRMAX,IXCEN,IYCEN,
+ NOFF,IXOFF,THRESH
6022 FORMAT(1X,'Subroutine radbgy',/,1X,'MODE',I3,' IRMIN,IRMAX',2I6,
+ ' IXCEN,IYCEN (Pixels)',2I6,' NOFF,IXOFF',2I4,/,1X,
+ 'Thresh',F8.2)
END IF
C
C---- Zero BGOD
C
DO 4 I = 1,IXWDTH
BGOD(I) = 0.0
4 CONTINUE
IIMIN = 10000
C
C---- Loop over rows (ie in Y direction) starting at centre of image
C
DO 50 I = IYCEN + IRMIN,IYCEN + IRMAX,ISTEP
II = ABS(I - IYCEN)
IIMIN = MIN(IIMIN,II)
IF (II.GT.IYLEN) THEN
WRITE(IOUT,FMT=6001) NREC
IF (ONLINE) WRITE(ITOUT,FMT=6001) NREC
6001 FORMAT(1X,'**** ERROR *****',/,1X,'Trying to determine ',
+ 'background outside the image, check beam centre ',
+ /,1X,'reduce RMAX if necessary')
RETURN
END IF
C
C---- test limits of I
C
IF ((I.LT.1) .OR. (I.GT.IYLEN)) GO TO 50
C
C **********************
c CALL RDROW(I,IXST,NPIXBG,IVAL,IERR)
CALL RDROW(I,IXST,IVAL,IERR)
C **********************
C
IF(IERR.EQ.-1)THEN
c WRITE(IOUT,FMT=6016)
c IF(ONLINE)WRITE(ITOUT,FMT=6016)
c 6016 FORMAT(3(/,'***** WARNING *****'),/,' Your direct beam',
c $ ' co-ordinates may be incorrect.',/
c $ ' CHECK the values supplied with your BEAM keyword')
RETURN
ENDIF
FIRST = .TRUE.
N = 0
SUM = 0
NRJ = 0
10 CONTINUE
C
C---- Loop over NPIXBG pixels
C
DO 20 J = 1,NPIXBG
C
IBA = INTPXL(IVAL(J))
CAL IF (J.LT.60) WRITE(6,*),'I,J,IBA',I,J,IBA
C
IF (FIRST) THEN
N = N + 1
PIX(N) = IBA
ELSE
Cal if (iba.le.(av(ii)+sigav(ii)*2))then
IF ((IBA.LE.(AV(II)+SIGAV(II)*1.5)).AND.
+ (IBA.GT.NULLPIX)) THEN
C
C---- Check if too big, ie probably spot
C
SUM = SUM + IBA
N = N + 1
ELSE
NRJ = NRJ + 1
END IF
END IF
20 CONTINUE
C
C
IF (FIRST) THEN
C
C---- Sort pixel values into ascending order
C
C ********************
CALL SORTUP4(NPIXBG,PIX,IS)
C ********************
C
C---- Set the background to the mean of the NPIXBG/3 smallest values,
C excluding zeros
C
NBACK = 0
SUM = 0.0
C
C
DO 30 J = 1,NPIXBG
IBA = PIX(IS(J))
IF (IBA.LE.NULLPIX) GO TO 30
NBACK = NBACK + 1
SUM = SUM + IBA
IF (NBACK.GE.NPIXBG/3) GO TO 40
30 CONTINUE
C
C
IF (LPRNT) WRITE (IOUT,FMT=6002) NPIXBG/3,NULLPIX,II*RAST
IF (ONLINE.AND.LPRNT) WRITE (ITOUT,FMT=6002) NPIXBG/3,NULLPIX,
+ II*RAST
6002 FORMAT (1X,'** WARNING **',/1X,'Less than',I3,' pixels with',
+ ' values greater than',I5,' (keyword NULLPIX) at a ',
+ 'radius of',F6.2,'mm')
CAL IERR = II
CAL RETURN
IF (NBACK.EQ.0) THEN
SUM = 1.0
NBACK = 1
END IF
C
40 AV(II) = SUM/NBACK
CAL WRITE(6,*),'average of first',av(ii)
ELSE
CAL WRITE(6,*),'n,sum',n,sum
IF (N.EQ.0) THEN
C
C---- When no accepted pixels, set AV to value from previous stripe
C
IF (II.GT.1) AV(II) = AV(II-1)
ELSE
C
C---- Average background
C
AV(II) = SUM/N
END IF
END IF
DEL = (REAL(AV(II))-IDIVIDE)
IF (DEL.LE.0) DEL = 1.0
SIGAV(II) = SQRT(GAIN*DEL)
SIGAV(II) = MAX(SIGAV(II),1.0)
C
C WRITE(6,*),'ii,av,sig',ii,av(ii),sigav(ii)
C
C
IF (FIRST) THEN
C WRITE(IOUT,2222) PIX
6004 FORMAT (1X,11I6)
FIRST = .FALSE.
SUM = 0
N = 0
NRJ = 0
NRJLAST = 0
GO TO 10
ELSE
C
C---- At end, calculate threshold for plot
C
IF (NRJ.EQ.NRJLAST) THEN
C
C WRITE(6,*),'ii, final av,sig',ii,av(ii),sigav(ii)
C
BGOD(II) = NINT((SIGAV(II)*THRESH)+AV(II))
NREJ(II) = NRJ
C WRITE(6,*),'II,THRESH,NREJ',ii,bgod(ii),nrej(ii)
ELSE
SUM = 0.0
N = 0
NRJLAST = NRJ
NRJ = 0
GO TO 10
END IF
END IF
50 CONTINUE
IF (LLPRNT) WRITE (IOUT,FMT=6006)
6006 FORMAT (1X,'Radial Background calculation complete')
DO 52 I = 1,IIMIN-1
BGOD(I) = BGOD(IIMIN)
52 CONTINUE
C IF (PRINT) THEN
C
C---- Find average over 4 pixels (0.6mm) at a time
C
NPT = 0
SIGAVG = 0.0
C
C---- Loop over strips
C
ISTEP = 4
IF (IRMAX.LT.0) ISTEP = -4
DO 60 I = IYCEN + IRMIN,IYCEN + IRMAX,ISTEP
NPT = NPT + 1
II =ABS(I - IYCEN)
IBGAV(NPT) = (AV(II+1)+AV(II)+AV(II+2)+AV(II+3))*0.25
ISIGBGAV(NPT) = (SIGAV(II+1)+SIGAV(II)+SIGAV(II+2)+SIGAV(II+3))*
+ 0.25
SIGAVG = SIGAVG + ISIGBGAV(NPT)
ISIGBGAV(NPT) = MAX(ISIGBGAV(NPT),2)
RAD(NPT) = II*RAST
NREJAV(NPT) = (NREJ(II+1)+NREJ(II)+NREJ(II+2)+NREJ(II+3))*0.25
60 CONTINUE
C
IF (NPT.GT.0) SIGAVG = SIGAVG/NPT
C
C WRITE(6,*),'npt',npt
C
NLI = NPT/12 + 1
I1 = -11
C
C
DO 70 I = 1,NLI
I1 = I1 + 12
I2 = I1 + 11
I2 = MIN(I2,NPT)
IF (LLPRNT) WRITE (IOUT,FMT=6008) (RAD(J),J=I1,I2)
IF (LLPRNT) WRITE (IOUT,FMT=6010) (IBGAV(J),J=I1,I2)
IF (LLPRNT) WRITE (IOUT,FMT=6012) (ISIGBGAV(J),J=I1,I2)
IF (LLPRNT) WRITE (IOUT,FMT=6014) (NREJAV(J),J=I1,I2)
IF (ONLINE.AND.LLPRNT) THEN
WRITE (ITOUT,FMT=6008) (RAD(J),J=I1,I2)
WRITE (ITOUT,FMT=6010) (IBGAV(J),J=I1,I2)
WRITE (ITOUT,FMT=6012) (ISIGBGAV(J),J=I1,I2)
WRITE (ITOUT,FMT=6014) (NREJAV(J),J=I1,I2)
END IF
70 CONTINUE
C
C
6008 FORMAT (1X,'RADIUS',12F6.1)
6010 FORMAT (1X,'BACKG ',12I6)
6012 FORMAT (1X,'SIGMA ',12I6)
6014 FORMAT (1X,'NREJ ',12I6)
C
C
RETURN
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== RASPLOT ==
C
SUBROUTINE RASPLOT(BB,IWX,IWY,MASK,MASKREJ,IDR,ODSCAL)
C ======================================================
C
IMPLICIT NONE
C
C
C---- To plot an average spot profile, stored in an integer*4 array bb
C assuming it is scaled to a maximum of 255.
C Called by CHKRAS
C
C Values are printed as 0-9, A-Z, preceeded with a "-" for
C background, "*" for rejected background.
C
C
C
C
C .. Scalar Arguments ..
REAL ODSCAL
INTEGER IDR,IWX,IWY
C ..
C .. Array Arguments ..
INTEGER BB(*),MASK(*),MASKREJ(*)
C ..
C .. Local Scalars ..
INTEGER I,I2WX,IJ,J,JJ,K,N,NUM,NXY,NBREJ,NBREJP1,MASKIJ,NR,
+ LINELEN,NUMLIN,IXW,IYW,NCH,NCHAR,BOTTOM,TOP
CHARACTER KSYMB*1,LINE*120,IMGNAM*100,LONGLINE*10100,
$ charstring*6
C ..
C .. Local Arrays ..
CHARACTER IA(84)*1,ICHAR(0:36)*1,ISYMB(-1:1)*1
C ..
C .. External Subroutines ..
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Common blocks ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C
SAVE
C ..
C .. Data statements ..
DATA ISYMB/'-','*',' '/
DATA KSYMB/' '/
DATA ICHAR/'0','1','2','3','4','5','6','7','8','9','A','B','C',
+ 'D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R',
+ 'S','T','U','V','W','X','Y','Z',']'/
C ..
C
C
DO 10 I = 1,84
IA(I) = KSYMB
10 CONTINUE
C
C
C----- Open window for display of average spot profile
C
IF (WINOPEN.AND.(.NOT.DISP_IO3)) THEN
LINELEN = MAX(2*IWX+1,50)
NUMLIN = IWY + 3
IXW = 100
IYW = 100
CALL MXDCIO(20,LINELEN, NUMLIN, IXW,IYW)
END IF
C
IF (WINOPEN) THEN
LINE = ' '
C
C---- Strip off directory path from full image filename
C
IMGNAM = CDSPTL
NCH = LENSTR(CDSPTL)
DO 12 I = NCH-1, 1, -1
IF ((CDSPTL(I:I).EQ.'/').OR.(CDSPTL(I:I).EQ.']')) THEN
IMGNAM = CDSPTL(I+1:NCH)
GOTO 14
END IF
12 CONTINUE
14 NCH = MIN(100,LENSTR(IMGNAM))
C
WRITE(LINE,FMT=6012) IMGNAM(1:NCH)
6012 FORMAT('Central profile:',A)
CALL MXDWIO(LINE,22)
END IF
C
NBREJ = MASKREJ(1)
NBREJP1 = NBREJ + 1
NXY = IWX*IWY
N = NXY
IF (IDR.EQ.1) N = IWY
I2WX = 2*IWX
IF (DEBUG(21)) WRITE (ITOUT,FMT=6000) IWX,IWY,NLI
C
C---- write spot profile in character format for passing through the socket
C
IF(SOCKLO)THEN
LONGLINE = ' '
CHARSTRING = ' '
c BOTTOM = 48
c TOP = 53
c WRITE(LONGLINE,FMT=6014)IWX,IWY
c 6014 FORMAT('',
$ '', i2, '',
$ i2, '')
c sorry Harry, but I don't think that we can have this!
6016 format(i5, 1x)
6015 format(i3, 1x)
longline = ' '
write(longline, fmt=6014)iwx, iwy
call write_socket_section(serverfd, lenstr(longline),
$ longline)
do ij = 1, iwx*iwy
longline = ' '
write(longline, fmt=6016) bb(ij)
call write_socket_section(serverfd, lenstr(longline),
$ longline)
end do
longline = ' '
write(longline, fmt=6017)
call write_socket_section(serverfd, lenstr(longline),
$ longline)
do ij = 1, iwx*iwy
longline = ' '
write(longline, fmt=6015) mask(ij)
call write_socket_section(serverfd, lenstr(longline),
$ longline)
end do
longline = ' '
write(longline, fmt=6018)
c DO 24 IJ=1,IWX*IWY
c WRITE (CHARSTRING,FMT=6016)BB(IJ)
c LONGLINE(BOTTOM:TOP) = CHARSTRING(1:6)
c BOTTOM = BOTTOM + 6
c TOP = TOP + 6
c 6016 FORMAT(I5,1X)
c 24 ENDDO
c TOP = BOTTOM + 4
c WRITE(LONGLINE(BOTTOM:TOP),FMT=6018)
6017 format('')
6018 format('')
c 6018 FORMAT(' "/>')
c PRINT*,LONGLINE(1:TOP)
CALL WRITE_SOCKET_length(SERVERFD,lenstr(longline),
$ LONGLINE)
LONGLINE = ' '
ENDIF
NCHAR = 1
TOP = 1
DO 30 J = 1,IWY
C
C
IJ = N - J + 1
JJ = 1
C
C
DO 20 I = 1,IWX
NUM = NINT((BB(IJ)*ODSCAL*35.0)/255.0)
IF (NUM.GT.35) NUM = 35
IF (NUM.LT.0) NUM = 36
C
C---- Test for rejected background points
C note that we are not going through mask in order 1 to nxy
C therefore have to test all elements of maskrej
C
MASKIJ = MASK(IJ)
C
C
IF ((MASKIJ.LT.0) .AND. (NBREJ.NE.0)) THEN
C
C
DO 22 NR = 2,NBREJP1
IF (IJ.EQ.MASKREJ(NR)) MASKIJ = 0
22 CONTINUE
C
C
END IF
IA(JJ) = ISYMB(MASKIJ)
IA(JJ+1) = ICHAR(NUM)
c IF(SOCKLO)THEN
WRITE(LONGLINE(TOP:TOP+2),FMT=1622)MASKIJ
1622 FORMAT(I2,1X)
c ENDIF
JJ = JJ + 2
IJ = IDR*IWY + IJ
TOP = TOP + 3
20 CONTINUE
C
C
IF (BRIEF) WRITE (IBRIEF,FMT=6002) (IA(K),K=1,I2WX)
IF (ONLINE) WRITE (ITOUT,FMT=6002) (IA(K),K=1,I2WX)
WRITE (IOUT,FMT=6004) IA
IF (WINOPEN) THEN
WRITE(LINE,FMT=6010) (IA(K),K=1,I2WX)
6010 FORMAT(120A1)
CALL MXDWIO(LINE, 22)
END IF
30 CONTINUE
C
C---- write out background mask to socket
C
c IF(SOCKLO)CALL WRITE_SOCKET_length(SERVERFD,lenstr(longline),
c $ LONGLINE)
C
C---- Format statements
C
6000 FORMAT (1X,'IWX,IWY=',2I5,' NLI=',I5)
6002 FORMAT (1X,84A1)
6004 FORMAT (20X,84A1)
C
C
END
C== RASPLOT4 ==
C
SUBROUTINE RASPLOT4(BB,IWX,IWY,MASK,MASKREJ,IDR)
C ================================================
C
C
C---- To plot an average spot profile, stored in an integer*4 array bb
C assuming it is scaled to a maximum of 10000
C
C Values are printed as 0-9, A-Z, preceeded with a "-" for
C background, "*" for rejected background.
C
C This is essentially identical to subroutine RASPLOT2 except for
C the type of array BB, which is I*4 in this subroutine, I*2 in
C RASPLOT2
C
C Note profile is stored with 'y' changing fastest, whereas we
C want to print it with 'x' changing fastest.
C idr is +1 if ods are stored in bb in stripes from right to
C left in film image, -1 if stored in reverse order
C note reverse order is no longer used !
C
C
C
C
C
C
C .. Scalar Arguments ..
INTEGER IDR,IWX,IWY
C ..
C .. Array Arguments ..
INTEGER MASK(*),MASKREJ(*),BB(*)
C ..
C .. Local Scalars ..
REAL BBIJ
INTEGER I,I2WX,IJ,J,JJ,K,MASKIJ,N,NBREJ,NBREJP1,NR,NUM,NXY
CHARACTER KSYMB*1
C ..
C .. Local Arrays ..
CHARACTER IA(84)*1,ICHAR(0:36)*1,ISYMB(-1:1)*1
C ..
C .. External Subroutines ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
SAVE
C .. Data statements ..
DATA ISYMB/'-','*',' '/
DATA KSYMB/' '/
DATA ICHAR/'0','1','2','3','4','5','6','7','8','9','A','B','C',
+ 'D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R',
+ 'S','T','U','V','W','X','Y','Z',']'/
C ..
C
C
DO 10 I = 1,84
IA(I) = KSYMB
10 CONTINUE
C
C
NBREJ = MASKREJ(1)
NBREJP1 = NBREJ + 1
NXY = IWX*IWY
N = NXY
IF (IDR.EQ.1) N = IWY
I2WX = 2*IWX
IF (DEBUG(21)) WRITE (ITOUT,FMT=6000) IWX,IWY,NLI
C
C
DO 40 J = 1,IWY
C
C
IJ = N - J + 1
JJ = 1
C
C
DO 30 I = 1,IWX
BBIJ = BB(IJ)
NUM = NINT((BBIJ*35.0)/10000.0)
IF (NUM.GT.35) NUM = 35
IF (NUM.LT.0) NUM = 36
C
C---- Test for rejected points (can be peak or background)
C note that we are not going through mask in order 1 to nxy
C therefore have to test all elements of maskrej
C
MASKIJ = MASK(IJ)
C
C
IF (NBREJ.NE.0) THEN
C
C
DO 20 NR = 2,NBREJP1
IF (IJ.EQ.MASKREJ(NR)) MASKIJ = 0
20 CONTINUE
C
C
END IF
C
C
IA(JJ) = ISYMB(MASKIJ)
IA(JJ+1) = ICHAR(NUM)
JJ = JJ + 2
IJ = IDR*IWY + IJ
30 CONTINUE
C
C
IF (ONLINE) WRITE (ITOUT,FMT=6002) (IA(K),K=1,I2WX)
IF (BRIEF) WRITE (IBRIEF,FMT=6002) (IA(K),K=1,I2WX)
WRITE (IOUT,FMT=6004) IA
40 CONTINUE
C
C---- Format statements
C
6000 FORMAT (1X,'IWX,IWY=',2I5,' NLI=',I5)
6002 FORMAT (1X,84A1)
6004 FORMAT (20X,84A1)
C
C
END
C== RASTOMM ==
C
C
C
SUBROUTINE RASTOMM(IXBOX,IYBOX,ILIM,JBOX,NMASKS)
C =====================================================
C
C---- Convert measurement box limits in scanner units to mm
C
C
C
C
C
C .. Scalar Arguments ..
REAL FACT
INTEGER JBOX,NMASKS
C ..
C .. Array Arguments ..
INTEGER ILIM(4),IXBOX(NMASKS,2),IYBOX(NMASKS,2)
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C
C
ILIM(1) = NINT(IXBOX(JBOX,1)*0.01)
ILIM(2) = NINT(IXBOX(JBOX,2)*0.01)
ILIM(3) = NINT(IYBOX(JBOX,1)*0.01)
ILIM(4) = NINT(IYBOX(JBOX,2)*0.01)
C
C
END
C== RDBLK ==
SUBROUTINE RDBLK(IBLK)
C =====================
C
C
C---- Check if record IBLK from image file has already been read into
C IMAGE, and if not, read it. Length of record comes from /SCN/.
C Note that if all image is not stored in memory (INCORE=FALSE)
C then IPOINT is always =1 (set in MAIN)
C
C
C Sets up the pointer IPOINT for the strip IBLK in IMAGE
C ISTART is the location (in stripes)
C of the first strip of data for this image in IMAGE, and is
C either 0 or NREC. This is because in order to implement summation
C of partially recorded reflections, both the current image and the
C next image are held in memory.
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IBLK
C ..
C .. Local Scalars ..
INTEGER ILEN,ISWAP,IERR
C ..
C .. External Subroutines ..
EXTERNAL GETBLK
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
SAVE
C
C
ISWAP = 0
IF (INCORE) THEN
IPOINT = (IBLK-1)*IYLEN + 1 + ISTART*IYLEN
IF (RDSTRIP(IBLK).or.machine.eq.'CBF ') THEN
RETURN
ELSE
RDSTRIP(IBLK) = .TRUE.
END IF
END IF
C
C **************************************
CALL GETBLK(IMAGE(IPOINT),NBYTE,IBLK,ISWAP,IERR)
C **************************************
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== RDIST ==
SUBROUTINE RDIST(CENTRE,FINAL,WELIMIT,ELIMIT,ELIMIT2,ELIMIT3,
+ BADSTART,RWEIGHT,REFREJ)
C ==============================================================
C
IMPLICIT NONE
C
C---- Refines detector centre, detector orientation, crystal to
C detector distance, yscal and detector distortions for flat
C detectors using a non-linear least squares method and reports
C new fiducial constants
C
C---- The number of parameters refined depends on the number of
C refinement spots (NRS). If less than 20, only the detector centre
C and orientation are refined. This is used in pattern matching.
C If refining the central region of the film, bulge is not refined.
C debug(11) this subroutine
C
C
C---- For image plate data from the Mar Research scanner, "Bulge" is
C replaced by a refineable radial offset (ROFF, independant of radius)
C and an additional parameter (TOFF) corresponding to a tangential
C offset has been added and a radial dependend tangential offset RDTOFF.
C These terms allow for any mis-alignment of the scanning head. They
C are all in 10 micron units.
C
C---- Last changed 11/7/89 to allow for use of partials in refinement
C
C---- Coordinates used in this subroutine
C
C (CLCX,CLCY) are from the generate-file and therefore
C in 10 micron units relative to the centre
C of the diffraction pattern
C
C (XRS,YRS) are in 10 micron units (from seekrs or next)
C
C
C---- Least squares refinement of xtofra,xcen,ycen and omega0
C done by fitting observed positions (xrs,yrs) to those
C in the generate-file (CLCX,CLCY)
C
C Individual parameters can be held fixed during refinement by
C use of REFINEMENT FIX ... keywords.
C
C Refineable parameters are:
C 1 XCEN
C 2 YCEN
C 3 OMEGA0
C 4 YSCAL
C 5 XTOFRA (Crystal to detector distance multiplier)
C 6 TILT
C 7 TWIST
C 8 ROFF for Image Plate, BULGE for film
C 9 TOFF
C 10 RDTOFF
C 11 RDROFF
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C ..
C .. Scalar Arguments ..
REAL WELIMIT,ELIMIT,ELIMIT2,ELIMIT3,REFREJ
LOGICAL CENTRE,FINAL,BADSTART,RWEIGHT
C ..
C .. Local Scalars ..
REAL DET,DX,DXTOF,DY,OMEGA0,RES,RESD,RESLIM,RESMX,RG,XC1,XM,XO,
+ XXG,YC1,YM,YO,YYG,PSI,CPSI,SPSI,WRES,WRESD,WRESMX,WDX,WDY,
+ WX,WY,WRESLIM,PXCEN,PYCEN,RAD,XMID,YMID,PI,RSCAN,SWDMAX,
+ SWDELSQ,PCCX,RTOD
INTEGER I,IBULGE,ICYC,IDX,IDY,IK,IR,ITILT,ITWIST,J,JDO,
+ K,MXJ,NOTRY,NP,NP2,NXD,IPT
LOGICAL REPT
CHARACTER*50 LINE
C ..
C .. Local Arrays ..
REAL CLCX(62),CLCY(62),DDX(NRPAR),DDY(NRPAR),
+ RF(NRPAR*NRPAR),W(NRPAR),R(NRPAR)
INTEGER XXGEN(62),YYGEN(62),IWRK1(NRPAR),IWRK2(NRPAR)
LOGICAL BAD(62)
C ..
C .. External Subroutines ..
EXTERNAL MINV,MMTOPX,MPAUSE
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ATAN2,COS,NINT,SIN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
SAVE
C
PI = 4.0*ATAN(1.0)
RTOD = 180.0/PI
RSCAN = SQRT(RSCANSQ)
IF (RSCAN.EQ.0.0) RSCAN = 1.0
C
C---- XMID, YMID are 10 micron coordinates of centre of image, needed
C for distortions ROFF and TOFF
C
XMID = 0.5*REAL(NREC)/FACT
YMID = 0.5*REAL(IYLEN)/FACT
C
C---- No. of parameters to refine. Additional parameter TOFF
C for image plates.
C
NP = 0
DO 2 I = 1,NRPAR
IF (.NOT.FIXPAR(I)) NP = NP + 1
2 CONTINUE
C
C---- For detector centre, do not refine bulge for film data and do
C not refine radial dependance of TOFF,ROFF for IP data (if these
C parameters are not fixed)
C
IF (CENTRE) THEN
IF (IMGP) THEN
IF (.NOT.FIXPAR(10)) NP = NP - 1
IF (.NOT.FIXPAR(11)) NP = NP - 1
ELSE
IF (.NOT.FIXPAR(8)) NP = NP - 1
END IF
END IF
C
C---- For less than 8 reflections, refine only three params
C
IF (NRS.LT.8) NP = 3
NP2 = NP*NP
IF (DEBUG(11)) THEN
WRITE(IOUT,FMT=6001) NP,CENTRE,(FIXPAR(I),I=1,NRPAR)
IF (ONLINE) WRITE(ITOUT,FMT=6001) NP,CENTRE,(FIXPAR(I),
+ I=1,NRPAR)
6001 FORMAT(/,1X,'Subroutine RDIST',/,1X,'Number of parameters',
+ ' to be refined',I3,/,1X,'(CENTRE is ',L1,')',/,1X,
+ 'FIXPAR flags: ',20L3)
END IF
C
C
OMEGA0 = ATAN2(SINOM0,COSOM0)
C
C
IF (LPRINT(2)) THEN
WRITE (IOUT,FMT=6000) NRS
6000 FORMAT (/' Detector distortion refinement using',I3,' SPOTS')
IF (ONLINE) WRITE (ITOUT,FMT=6000) NRS
END IF
C
C---- Get coords from generate file
C
IF (DEBUG(11)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6002)
6002 FORMAT (/1X,'List of reflections used in refinement',/2X,'NO IRE',
+ 'CG XG YG SDX SDY')
WRITE (IOUT,FMT=6002)
END IF
C
C
DO 10 J = 1,NRS
C Take ABS in case partials are being used (flagged by -ve RRS)
IR = ABS(RRS(J))
XXGEN(J) = XG(IR)
YYGEN(J) = YG(IR)
BAD(J) = .FALSE.
IF (.NOT.RWEIGHT) THEN
WXRS(J) = 1.0
WYRS(J) = 1.0
END IF
C
C
10 CONTINUE
C
C---- Initial phase angle for radial dependence of ROFF, TOFF
C
IF (NPHI.EQ.0) THEN
ROFFPHI = 0.0
TOFFPHI = 0.0
ELSE IF (NPHI.EQ.1) THEN
ROFFPHI = 0.25*PI
TOFFPHI = 0.25*PI
ELSE IF (NPHI.EQ.2) THEN
ROFFPHI = 0.5*PI
TOFFPHI = 0.5*PI
ELSE IF (NPHI.EQ.3) THEN
ROFFPHI = 0.75*PI
TOFFPHI = 0.75*PI
END IF
NOTRY = 0
C
C---- Return here for each new round of refinement cycles
C
20 CONTINUE
RESMX = 0
RESD = 0.0
WRESMX = 0.0
WRESD = 0.0
C
C
DO 30 J = 1,NRS
XXG = XXGEN(J)
YYG = YYGEN(J)
WX = 1.0/WXRS(J)**2
WY = 1.0/WYRS(J)**2
C
C *******************************
CALL MMTOPX(CLCX(J),CLCY(J),XXG,YYG)
C *******************************
C
DX = CLCX(J) - XRS(J)
DY = CLCY(J) - YRS(J)
IF (.NOT.BAD(J)) THEN
RES = DX*DX + DY*DY
RESD = RESD + RES
WRES = WX*DX*DX + WY*DY*DY
WRESD = WRESD + WRES
C
C
IF (RWEIGHT) THEN
IF (WRES.GE.WRESMX) THEN
WRESMX = WRES
MXJ = J
END IF
ELSE
IF (RES.GE.RESMX) THEN
RESMX = RES
MXJ = J
END IF
END IF
END IF
C
IF (DEBUG(11)) THEN
IR = ABS(RRS(J))
IF (ONLINE) WRITE (ITOUT,FMT=6004) J,RRS(J),XG(IR),YG(IR),
+ XRS(J),YRS(J),WXRS(J),WYRS(J),DX/WXRS(J),DY/WYRS(J),WRESMX,MXJ
6004 FORMAT (1X,I3,I6,4F8.1,2F6.3,5X,2F8.2,F8.0,I3)
WRITE (IOUT,FMT=6004) J,RRS(J),XG(IR),YG(IR),XRS(J),YRS(J),
+ WXRS(J),WYRS(J),DX/WXRS(J),DY/WYRS(J),WRESMX,MXJ
END IF
30 CONTINUE
C
C
RESMX = SQRT(RESMX)
RMSRES = SQRT(RESD/ (NRS-NOTRY+1))
RESLIM = REFREJ*RMSRES
WRESMX = SQRT(WRESMX)
SWDELSQ = SQRT(WRESD)
WRMSRES = SQRT(WRESD/ (NRS-NOTRY+1))
WRESLIM = REFREJ*WRMSRES
C
C
IF (NOTRY.EQ.0) THEN
IF (LPRINT(2)) THEN
IF (RWEIGHT) THEN
WRITE (IOUT,FMT=6006) 0.01*RMSRES,WRMSRES
6006 FORMAT (1X,'Starting residual=',F5.3,'mm; Weighted residual',F6.2)
IF (ONLINE) WRITE (ITOUT,FMT=6006) 0.01*RMSRES,WRMSRES
ELSE
WRITE (IOUT,FMT=6007) 0.01*RMSRES
6007 FORMAT (1X,'Starting residual=',F5.3,'mm')
IF (ONLINE) WRITE (ITOUT,FMT=6007) 0.01*RMSRES
END IF
END IF
C
C
IF (RWEIGHT) WESTART = WRMSRES
ESTART = RMSRES
ELSE
C
C
IF (NOTRY.EQ.1) THEN
IF (LPRINT(2)) THEN
IF (RWEIGHT) THEN
WRITE (IOUT,FMT=6012) 0.01*RMSRES,WRMSRES
6012 FORMAT (1X,'Residual after 1 CYCLE=',F5.3,'mm; Weighted residual',
+ F6.2)
IF (ONLINE) WRITE (ITOUT,FMT=6012) 0.01*RMSRES,WRMSRES
ELSE
WRITE (IOUT,FMT=6011) 0.01*RMSRES
6011 FORMAT (1X,'Residual after 1 CYCLE=',F5.3,'mm')
IF (ONLINE) WRITE (ITOUT,FMT=6011) 0.01*RMSRES
END IF
END IF
END IF
C
C---- Allow maximum of 10% of reflections to be rejected
C
IF (NOTRY.GT.NRS/10) GO TO 120
IF (RWEIGHT) THEN
CAL IF (WRESMX.LT.WRESLIM) GO TO 120
IF (WRESMX.LT.REFREJ) GO TO 120
ELSE
IF (RESMX.LT.RESLIM) GO TO 120
END IF
IF (DEBUG(11)) THEN
WRITE(IOUT,FMT=6013) MXJ
IF (ONLINE) WRITE(ITOUT,FMT=6013) MXJ
6013 FORMAT(1X,'Rejecting reflection',I3,' in list')
END IF
BAD(MXJ) = .TRUE.
END IF
C
C---- Start main loop
C
C---- Start loop for non-linear refinement
C
DO 110 ICYC = 1,2
C
C---- Initialize sums
C
DO 40 K = 1,NP
W(K) = 0.0
40 CONTINUE
C
C
DO 50 K = 1,NP2
RF(K) = 0.0
50 CONTINUE
C
C---- Set up normal equations
C
DO 80 J = 1,NRS
C
C
IF (.NOT.BAD(J)) THEN
XXG = XXGEN(J)
YYG = YYGEN(J)
RG = SQRT(XXG*XXG+YYG*YYG)
XM = XXG*COSOM0 - YYG*SINOM0
YM = YYG*COSOM0 + XXG*SINOM0
C
C ***********************
CALL MMTOPX(XC1,YC1,XXG,YYG)
C ***********************
C
PSI = ATAN2(YCEN+YM-YMID,XCEN+XM-XMID)
CPSI = COS(PSI)
SPSI = SIN(PSI)
RAD = SQRT((XCEN+XM-XMID)**2+(YCEN+YM-YMID)**2)
CAL IF (J.LT.3) THEN
CAL WRITE(6,*),'XG,YG',XXG,YYG
CAL WRITE(6,*),'YCEN,YMID,YM',YCEN,YMID,YM
CAL WRITE(6,*),'XCEN,XMID,XM',XCEN,XMID,XM
CAL WRITE(6,*),'PSI,RAD',PSI*57,RAD
CAL END IF
IF (IMGP) THEN
DXTOF = TILT*XXG + XTOFRA + TWIST*YYG
ELSE
DXTOF = TILT*XXG + XTOFRA + TWIST*YYG + BULGE*RG
END IF
IPT = 0
C
C XCEN
C
IF (.NOT.FIXPAR(1)) THEN
IPT = IPT + 1
DDX(IPT) = 1.0
DDY(IPT) = 0.0
END IF
C
C YCEN
C
IF (.NOT.FIXPAR(2)) THEN
IPT = IPT + 1
DDX(IPT) = 0.0
DDY(IPT) = 1.0
END IF
C
C OMEGA0
C
IF (.NOT.FIXPAR(3)) THEN
IPT = IPT + 1
DDX(IPT) = -YM*DXTOF
DDY(IPT) = XM*DXTOF*YSCAL
END IF
C
C YSCAL
C
IF (.NOT.FIXPAR(4)) THEN
IPT = IPT + 1
DDX(IPT) = 0.0
DDY(IPT) = YM*DXTOF
END IF
C
C XTOFRA
C
IF (.NOT.FIXPAR(5)) THEN
IPT = IPT + 1
DDX(IPT) = XM
DDY(IPT) = YSCAL*YM
END IF
C
C TILT
C
IF (.NOT.FIXPAR(6)) THEN
IPT = IPT + 1
DDX(IPT) = XXG*XM
DDY(IPT) = XXG*YM*YSCAL
END IF
C
C TWIST
C
IF (.NOT.FIXPAR(7)) THEN
IPT = IPT + 1
DDX(IPT) = YYG*XM
DDY(IPT) = YYG*YM*YSCAL
END IF
C
C
C ROFF or BULGE
C
C
IF (.NOT.FIXPAR(8)) THEN
IF (.NOT.IMGP) THEN
C
C---- Film bulge, do not refine for central region
C
IF (.NOT.CENTRE) THEN
IPT = IPT + 1
DDX(IPT) = XM*RG
DDY(IPT) = YM*YSCAL*RG
END IF
ELSE
C
C---- Image plate, radial offset ROFF
C
IPT = IPT + 1
DDX(IPT) = CPSI
DDY(IPT) = SPSI
END IF
END IF
C
C fixed tangential offset TOFF
C
IF (.NOT.FIXPAR(9)) THEN
IPT = IPT + 1
DDX(IPT) = -SPSI
DDY(IPT) = CPSI
END IF
C
C---- Radially dependent TOFF, amplitude RDTOFF
C Do not refine if using only spots from centre of detector
C
IF ((.NOT.FIXPAR(10)).AND.(.NOT.CENTRE)) THEN
IPT = IPT + 1
DDX(IPT) = -SPSI*SIN(PI*NODES*RAD/RSCAN+TOFFPHI)
DDY(IPT) = CPSI*SIN(PI*NODES*RAD/RSCAN+TOFFPHI)
END IF
C
C
C---- Radially dependent ROFF, amplitude RDROFF
C Do not refine if using only spots from centre of detector
C
IF ((.NOT.FIXPAR(11)).AND.(.NOT.CENTRE)) THEN
IPT = IPT + 1
DDX(IPT) = CPSI*SIN(PI*NODES*RAD/RSCAN+ROFFPHI)
DDY(IPT) = SPSI*SIN(PI*NODES*RAD/RSCAN+ROFFPHI)
END IF
C
C
IF (IPT.GT.NRPAR) THEN
WRITE(6,*)'* FATAL ERROR, NUMBER OF REFINED PARAMETERS'
WRITE(6,*)'EXCEEDS PARAMETER NRPAR IN SUBROUTINE RDIST'
STOP
END IF
C
WX = 1.0/WXRS(J)**2
WY = 1.0/WYRS(J)**2
C
XO = XRS(J) - XC1
YO = YRS(J) - YC1
IK = 0
C
C
DO 70 I = 1,NP
W(I) = DDX(I)*XO*WX + W(I) + DDY(I)*YO*WY
C
C
DO 60 K = 1,NP
IK = IK + 1
RF(IK) = DDX(I)*DDX(K)*WX + RF(IK) + DDY(I)*DDY(K)*WY
60 CONTINUE
70 CONTINUE
C
C
END IF
80 CONTINUE
C
C
IF (DEBUG(11)) THEN
WRITE (IOUT,FMT=6008)
6008 FORMAT (/1X,'Normal matrix RF')
WRITE (IOUT,FMT=6010) (RF(JDO),JDO=1,NP)
6010 FORMAT (1X,14(E10.2))
C
C
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6008)
WRITE (ITOUT,FMT=6010) (RF(JDO),JDO=1,NP)
END IF
END IF
C
C---- Solve
C
C ********************
CALL MINV(RF,NP,DET,IWRK1,IWRK2)
C ********************
C
IK = 0
C
C
DO 100 I = 1,NP
R(I) = 0.0
C
C
DO 90 K = 1,NP
IK = IK + 1
R(I) = RF(IK)*W(K) + R(I)
90 CONTINUE
100 CONTINUE
C
C---- Update parameters
C
IPT = 0
IF (.NOT.FIXPAR(1)) THEN
IPT = IPT + 1
XCEN = R(IPT) + XCEN
END IF
IF (.NOT.FIXPAR(2)) THEN
IPT = IPT + 1
YCEN = R(IPT) + YCEN
END IF
IF (.NOT.FIXPAR(3)) THEN
IPT = IPT + 1
OMEGA0 = R(IPT) + OMEGA0
SINOM0 = SIN(OMEGA0)
COSOM0 = COS(OMEGA0)
END IF
IF (.NOT.FIXPAR(4)) THEN
IPT = IPT + 1
YSCAL = R(IPT) + YSCAL
END IF
IF (.NOT.FIXPAR(5)) THEN
IPT = IPT + 1
XTOFRA = R(IPT) + XTOFRA
END IF
IF (.NOT.FIXPAR(6)) THEN
IPT = IPT + 1
TILT = R(IPT) + TILT
END IF
IF (.NOT.FIXPAR(7)) THEN
IPT = IPT + 1
TWIST = R(IPT) + TWIST
END IF
IF (.NOT.FIXPAR(8)) THEN
IF (.NOT.IMGP) THEN
IF (.NOT.CENTRE) THEN
IPT = IPT + 1
BULGE = BULGE + R(IPT)
END IF
ELSE
IPT = IPT + 1
ROFF = ROFF + R(IPT)
END IF
END IF
IF (.NOT.FIXPAR(9)) THEN
IPT = IPT + 1
TOFF = TOFF + R(IPT)
END IF
IF ((.NOT.FIXPAR(10)).AND.(.NOT.CENTRE)) THEN
IPT = IPT + 1
RDTOFF = RDTOFF + R(IPT)
END IF
IF ((.NOT.FIXPAR(11)).AND.(.NOT.CENTRE)) THEN
IPT = IPT + 1
RDROFF = RDROFF + R(IPT)
END IF
C
C
110 CONTINUE
C
C---- End of non-linear refinement loop
C
C---- Calculate std.devs. and test residuals
C
NOTRY = NOTRY + 1
GO TO 20
C
C---- Print out
C
120 IF (NOTRY.GT.1) THEN
C
C
IF (LPRINT(2)) THEN
WRITE (IOUT,FMT=6014) REFREJ
6014 FORMAT (/,2X,'REJECTS (Error>',F4.1,'*rms RESID.) coords in mm',
+ /,1X,' X DELX DELX/SIGMA Y DELY DELY/SIGMA')
IF (ONLINE) WRITE (ITOUT,FMT=6014) REFREJ
END IF
END IF
C
C
NREJS = 0
C
C
DO 130 J = 1,NRS
C
C
IF (BAD(J)) THEN
NREJS = NREJS + 1
DX = XRS(J) - CLCX(J)
DY = YRS(J) - CLCY(J)
WDX = DX/WXRS(J)
WDY = DY/WYRS(J)
C
C
IF (LPRINT(2)) THEN
IDX = XRS(J) - XCEN
IDY = YRS(J) - YCEN
WRITE (IOUT,FMT=6016) 0.01*IDX,0.01*DX,WDX,
+ 0.01*IDY,0.01*DY,WDY
6016 FORMAT (2(F10.2,F7.2,F7.1))
IF (ONLINE) WRITE (ITOUT,FMT=6016) 0.01*IDX,0.01*DX,WDX,
+ 0.01*IDY,0.01*DY,WDY
END IF
END IF
130 CONTINUE
C
C
IF (RWEIGHT) THEN
REPT = ((ESTART.GT.WELIMIT) .OR. (RMSRES.GT.WELIMIT))
ELSE
REPT = ((ESTART.GT.ELIMIT2) .OR. (RMSRES.GT.ELIMIT3))
END IF
NXD = NINT(XTOFD*XTOFRA)
ITILT = TILT/FDIST
ITWIST = TWIST/FDIST
IF (.NOT.IMGP) IBULGE = BULGE/FDIST
IF (IMGP) THEN
PXCEN = 0.01*XCEN
PYCEN = 0.01*YCEN/YSCAL
IF (INVERTX) PXCEN = NREC*RAST - PXCEN
C
C---- IP data
C
IF (RWEIGHT) THEN
C
IF ((BRIEF.AND.FINAL).OR.(BRIEF.AND.(BADSTART.OR.(.NOT.REPT))))
+ WRITE (IBRIEF,FMT=6017) 0.01*RMSRES,WRMSRES,PXCEN,
+ PYCEN,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*ROFF,
+ 0.01*TOFF,0.01*RDROFF,0.01*RDTOFF
IF (DEBUG(11)) THEN
WRITE(IOUT,FMT=6032) RDROFF,ROFFPHI,RDTOFF,TOFFPHI,NODES,
+ SWDELSQ
IF (ONLINE) WRITE(ITOUT,FMT=6032) RDROFF,ROFFPHI,RDTOFF,
+ TOFFPHI,NODES,SWDELSQ
6032 FORMAT(1X,'RDROFF',F8.2,' ROFFPHI',F7.4,' RDTOFF',F8.2,
+ ' TOFFPHI',F7.4,' NODES=',I3,' SWDELSQ',F10.2)
END IF
C
IF (SPIRAL) THEN
WRITE (IOUT,FMT=6017) 0.01*RMSRES,WRMSRES,PXCEN,PYCEN,
+ XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*ROFF,0.01*TOFF,
+ 0.01*RDROFF,0.01*RDTOFF
6017 FORMAT (' Final rms residual:',F8.3,'mm; Weighted residual',F7.1,
+ /3X,'XCEN YCEN XTOFRA ',
+ ' XTOFD YSCALE TILT TWIST ROFF TOFF RDROFF RDTOFF',
+ /1X,F6.2,F8.2,F8.4,F8.2,F8.4,2I6,4F7.3)
IF (ONLINE) WRITE (ITOUT,FMT=6017) 0.01*RMSRES,WRMSRES,PXCEN,
+ PYCEN,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*ROFF,
+ 0.01*TOFF,0.01*RDROFF,0.01*RDTOFF
ELSE
WRITE (IOUT,FMT=6030) 0.01*RMSRES,WRMSRES,PXCEN,PYCEN,
+ XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST
6030 FORMAT (' Final rms residual:',F8.3,'mm; Weighted residual',F7.1,
+ /3X,'XCEN YCEN XTOFRA ',
+ ' XTOFD YSCALE TILT TWIST',
+ /1X,F6.2,F8.2,F8.4,F8.2,F8.4,2I6)
IF (ONLINE) WRITE (ITOUT,FMT=6030) 0.01*RMSRES,WRMSRES,PXCEN,
+ PYCEN,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST
END IF
ELSE
C
C---- If NOT RWEIGHT
C
IF ((BRIEF.AND.FINAL).OR.(BRIEF.AND.(BADSTART.OR.(.NOT.REPT))))
+ WRITE (IBRIEF,FMT=6019) 0.01*RMSRES,PXCEN,
+ PYCEN,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*ROFF,
+ 0.01*TOFF,0.01*RDROFF,0.01*RDTOFF
IF (SPIRAL) THEN
WRITE (IOUT,FMT=6019) 0.01*RMSRES,PXCEN,PYCEN,
+ XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*ROFF,0.01*TOFF,
+ 0.01*RDROFF,0.01*RDTOFF
6019 FORMAT (' Final rms residual:',F8.3,'mm',
+ /3X,'XCEN YCEN XTOFRA ',
+ ' XTOFD YSCALE TILT TWIST ROFF TOFF',
+ ' RDROFF RDTOFF'/1X,F6.2,
+ F8.2,F8.4,F8.2,F8.4,2I6,4F7.3)
IF (ONLINE) WRITE (ITOUT,FMT=6019) 0.01*RMSRES,PXCEN,
+ PYCEN,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*ROFF,
+ 0.01*TOFF,0.01*RDROFF,0.01*RDTOFF
ELSE
WRITE (IOUT,FMT=6034) 0.01*RMSRES,PXCEN,PYCEN,
+ XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST
6034 FORMAT (' Final rms residual:',F8.3,'mm',
+ /3X,'XCEN YCEN XTOFRA ',
+ ' XTOFD YSCALE TILT TWIST',/1X,F6.2,
+ F8.2,F8.4,F8.2,F8.4,2I6)
IF (ONLINE) WRITE (ITOUT,FMT=6034) 0.01*RMSRES,PXCEN,
+ PYCEN,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST
END IF
END IF
C
ELSE
C
C---- Film data
C
IF (RWEIGHT) THEN
WRITE (IOUT,FMT=6018) 0.01*RMSRES,WRMSRES,0.01*XCEN,
+ 0.01*YCEN/YSCAL,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*IBULGE
6018 FORMAT (' Final rms residual:',F8.3,'mm; Weighted residual',F7.1,
+ /6X,'XCEN YCEN XTOFRA ',
+ ' XTOFD YSCALE TILT TWIST BULGE',/2X,2F8.2,F8.4,
+ F8.2,F8.4,2I8,F8.2)
IF (ONLINE) WRITE (ITOUT,FMT=6018) 0.01*RMSRES,WRMSRES,0.01*XCEN,
+ 0.01*YCEN/YSCAL,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,
+ 0.01*IBULGE
ELSE
WRITE (IOUT,FMT=6021) 0.01*RMSRES,0.01*XCEN,0.01*YCEN/YSCAL,
+ XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,0.01*IBULGE
6021 FORMAT (' Final rms residual:',F8.3,'mm',
+ /6X,'XCEN YCEN XTOFRA ',
+ ' XTOFD YSCALE TILT TWIST BULGE',/2X,2F8.2,F8.4,
+ F8.2,F8.4,2I8,F8.2)
IF (ONLINE) WRITE (ITOUT,FMT=6021) 0.01*RMSRES,0.01*XCEN,
+ 0.01*YCEN/YSCAL,XTOFRA,0.01*NXD,YSCAL,ITILT,ITWIST,
+ 0.01*IBULGE
END IF
END IF
C
C---- Print refined fiducial constants
C
CCX = XCEN - XCENF
PCCX = CCX
IF (INVERTX) PCCX = -PCCX
C
C---- CCY is in "pixels" rather than mm, so do NOT divide by YSCAL
C here, but do divide when printing.
C
CAL CCY = YCEN/YSCAL - YCENF
CCY = YCEN - YCENF
C
C
CCOM = (OMEGA0-OMEGAF)*RTOD
IF (CCOM.LT.-180.0) CCOM = CCOM + 360.0
WRITE (IOUT,FMT=6020) 0.01*PCCX,0.01*CCY/YSCAL,CCOM
6020 FORMAT (' Refined Fiducial constants (mm and degrees)',
+ /,1X,' CCX: ',F8.2,' CCY: ',F8.2,' CCOM:',F10.4)
IF (ONLINE) WRITE (ITOUT,FMT=6020) 0.01*PCCX,0.01*CCY/YSCAL,CCOM
IF ((BRIEF.AND.FINAL).OR.(BRIEF.AND.(BADSTART.OR.(.NOT.REPT))))
+ THEN
WRITE (IBRIEF,FMT=6020) 0.01*PCCX,0.01*CCY/YSCAL,CCOM
IF (.NOT.GRAPH) CALL MPAUSE
END IF
C
C
IF (WINOPEN.AND.DISP_IO3.AND.(.NOT.CENTRE)) THEN
WRITE(LINE,FMT=6040) 0.01*RMSRES,WRMSRES
6040 FORMAT('Rms residual',F6.2,'mm, weighted residual',
+ F6.1)
CALL MXDWIO(LINE,22)
END IF
C If BRIEF,then if this is central region, return if not the
C FINAL cycle. If NOT the central region, return if a repeat
C has been flagged (REPT) but not yet done (BADSTART=FALSE)
IF (BRIEF.AND.( (CENTRE.AND.(.NOT.FINAL)) .OR.
+ (.NOT.CENTRE.AND.(REPT.AND.(.NOT.BADSTART))) ))
+ RETURN
END
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE RDROW(IY,IXST,IVAL,IERR)
C ==================================
IMPLICIT NONE
C
C---- Reads a row of values from IMAGE (ie in the slow direction)
C for row IY putting results into IVAL, starting at IXST and
C getting NVAL values (NVAL = parameter NPIXBG)
C (required for determining radial Y background)
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IY,IXST,NVAL,IERR
C ..
C .. Array Arguments ..
INTEGER*2 IVAL(IXWDTH)
C ..
C .. Local Scalars ..
INTEGER I,IPT
C ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
SAVE
IERR = 0
NVAL = NPIXBG
C
C---- Check for limits of image
C
IF (IXST+NVAL-1.GT.IYLEN)NVAL = INT(IYLEN) - IXST + 1
C
C---- Set pointer for first pixel
C
IPT = (IXST-1)*IYLEN + IY
C
IF((IPT.GT.0).AND.(IPT.LE.NREC*IYLEN))THEN
DO 10 I = 1,NVAL
IVAL(I) = IMAGE(IPT)
IPT = IPT + IYLEN
10 CONTINUE
ELSE
c WRITE(IOUT,FMT=6000)IPT,NREC*IYLEN
c IF(ONLINE)WRITE(ITOUT,FMT=6000)IPT,NREC*IYLEN
c 6000 FORMAT(3(/,'***** WARNING *****'),/,' Pointer IPT has',
c $ ' been set to an illegal value; your direct beam',
c $ ' co-ordinates',/,' may be incorrect.',/,' IPT = ',I9,
c $ ' Minimum allowed value = 1, maximum allowed value = ',
c $ I8,/,' CHECK the values supplied with your BEAM keyword')
c CALL SHUTDOWN
IERR = -1
ENDIF
RETURN
END
C== RDSPOT ==
SUBROUTINE RDSPOT(IFLAG)
IMPLICIT NONE
C
C---- Open file and read a list of spots from IMSTILLS.
C IFLAG (returned) = 0 File opened Ok
C = 1 Abort
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IFLAG
C
C ..
C .. Local Scalars ..
INTEGER IXW,IYW,LINELEN,NUMLIN,IBUTTON,IXP,IYP,L,ISTAT,IFAIL
CHARACTER LINE*80,STR*100
REAL XX,YY,PHIS,FRAC,FINT,DTOR
C ..
C .. External Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C ..
C .. External Subroutines ..
EXTERNAL MXDCIO,MXDWIO,XDLF_POPUP_NOTICE
C ..
C .. Common blocks ..
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
SAVE
C
C---- Defines format of "spots" file from IMSTILLS, which will be
C NEW for version that deals with swung detectors.
C
CAL NEW = .TRUE.
DTOR = ATAN(1.0)*4.0/180.0
IF (YSCAL.EQ.0.0) YSCAL = 1.0
IFLAG = 0
ISPOT = 10
NSPT = 0
ITHRESH = 0
IXP = 400
IYP = 400
STR = 'Filename: '
10 CALL MXDDLG(STR, IXP,IYP,SPTNAM,ISTAT)
IFAIL = 1
CALL CCPDPN (ISPOT,SPTNAM,'OLD','F',80,IFAIL)
C
C---- Trap file open failure
C
IF (IFAIL.LT.0) THEN
LINE = 'File not found'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,XDLSTR(' '),0,
$ XDLSTR('Try again'),9,XDLSTR('Abort'),5,3,0,IBUTTON)
IF (IBUTTON.EQ.1) THEN
GOTO 10
ELSE
IFLAG = 1
RETURN
END IF
END IF
IF (NEWSPT) THEN
READ (ISPOT,FMT=*,END=90,ERR=90) LIXLEN,LIYLEN,
+ LPIXEL,LYSCALE,LOMEGA,INVFLAG,LISWUNG
READ (ISPOT,FMT=*,END=90,ERR=90) LXCEN,LYCEN
NSPT = 1
IF (INVFLAG.EQ.1) THEN
XSPT(NSPT) = LIXLEN*LPIXEL - LXCEN
ELSE
XSPT(NSPT) = LXCEN
END IF
YSPT(NSPT) = LYCEN
ELSE
C
C---- Read list of spots.
C record 1 ccx,ccy camera constants,
C records 2-4 Pseudo fiducial coordinates
C
READ (ISPOT,FMT=*,END=90,ERR=90) XF,YF
READ (ISPOT,FMT=*,END=90,ERR=90) XFID1,YFID1
READ (ISPOT,FMT=*,END=90,ERR=90) XFID2,YFID2
READ (ISPOT,FMT=*,END=90,ERR=90) XFID3,YFID3
END IF
C
C---- Now the spots themselves. In new style spots format the coordinates
C are in mm relative to an origin at the first pixel in the image.
C
20 READ (ISPOT,FMT=*,END=90,ERR=90) XX,YY,FRAC,PHIS,FINT
IF (XX.LT.-90) GOTO 30
NSPT = NSPT + 1
IF (NSPT.EQ.1) PHIIMG = PHIS
IF (NSPT.GT.NSPOTS) THEN
WRITE(IOUT,FMT=6000) NSPOTS
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSPOTS
6000 FORMAT(1X,'Too many spots in spots file, maximum is',I6,
+ /,1X,'Either change the parameter NSPOTS in the ',
+ 'source code and recompile the program',/,1X,
+ /,1X,'or edit the spots file to remove extra spots')
GOTO 30
END IF
C
IF (NEWSPT) THEN
IF (INVFLAG.EQ.1) XX = LIXLEN*LPIXEL - XX
XSPT(NSPT) = XX
YSPT(NSPT) = YY
ELSE
C
C---- test for OMEGAF approx 90 or 180 (it is 180 for R-axis at Daresbury)
C
IF (ABS(OMEGAF/DTOR-90.0).LT.1.0) THEN
XSPT(NSPT) = 2*YFID1 - YY
YSPT(NSPT) = XX
ELSE IF (ABS(OMEGAF/DTOR-180.0).LT.1.0) THEN
XSPT(NSPT) = 2*XFID1 - XX
YSPT(NSPT) = (2*YFID1 - YY)*YSCAL
END IF
END IF
ISPT(NSPT) = FINT
GOTO 20
C
C---- Terminator found, all spots stored
C
30 CLOSE(ISPOT)
RETURN
C
C---- Errors reading spots file
C
90 WRITE(IOUT,FMT=6010)
IF (ONLINE) WRITE(ITOUT,FMT=6010)
6010 FORMAT(1X,'End of file reading spots list')
IFLAG = 1
RETURN
C
END
C
C== READPROF ==
SUBROUTINE READPROF
C ..
C .. Scalar Arguments ..
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
RETURN
END
C== RECCEL ==
C
C
C
SUBROUTINE RECCEL(R,C,WAVE)
C ==========================
C
C
C
C---- Convert real cell parameters to reciprocal cell parameters or
C vice versa
C R(6) Output cell parameters
C C(6) Input cell parameters
C WAVE Wavelength
C
C Angles should be in degrees
C
C
C
C
C .. Scalar Arguments ..
REAL WAVE
C ..
C .. Array Arguments ..
REAL C(6),R(6)
C ..
C .. Local Scalars ..
REAL SUM,V,WV,DTOR,X
INTEGER I
C ..
C .. Intrinsic Functions ..
INTRINSIC SQRT,ACOS,COS,SIN,ATAN,SIGN
C ..
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
C
SUM = 0.0
C
C
DO 10 I = 4,6
SUM = DTOR*C(I)*0.5 + SUM
10 CONTINUE
C
C
V = 1.0
C
C
DO 20 I = 4,6
V = SIN(SUM-DTOR*C(I))*V
20 CONTINUE
C
C
WV = WAVE/ (C(1)*2.0*C(2)*C(3)*SQRT(SIN(SUM)*V))
R(1) = C(2)*C(3)*SIN(DTOR*C(4))*WV
R(2) = C(1)*C(3)*SIN(DTOR*C(5))*WV
R(3) = C(1)*C(2)*SIN(DTOR*C(6))*WV
C
X = (COS(DTOR*C(5))*COS(DTOR*C(6))-COS(DTOR*C(4)))/
+ (SIN(DTOR*C(5))*SIN(DTOR*C(6)))
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
R(4) = ACOS(X)
C
X = (COS(DTOR*C(6))*COS(DTOR*C(4))-COS(DTOR*C(5)))/
+ (SIN(DTOR*C(6))*SIN(DTOR*C(4)))
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
R(5) = ACOS(X)
C
X = (COS(DTOR*C(4))*COS(DTOR*C(5))-COS(DTOR*C(6)))/
+ (SIN(DTOR*C(4))*SIN(DTOR*C(5)))
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
R(6) = ACOS(X)
C
DO 30 I = 4,6
R(I) = R(I)/DTOR
30 CONTINUE
C
C
END
C=== RECPACK ===
SUBROUTINE RECPACK(IARR,IREC)
C
C---- Pack record number (I*4 variable) into the integer*2 array IARR
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER IREC
C ..
C .. Array Arguments ..
INTEGER*2 IARR(2)
C ..
C .. Local Scalars ..
INTEGER IRECNO
C ..
C .. Local Arrays ..
INTEGER*2 IBUF(2)
C
C .. Equivalences ..
EQUIVALENCE (IRECNO,IBUF(1))
IRECNO = IREC
IARR(1) = IBUF(1)
IARR(2) = IBUF(2)
END
C=== RECUNPACK ===
SUBROUTINE RECUNPACK(IARR,IREC)
C
C---- Unpack record number (I*4 variable) from the integer*2 array IARR
C
IMPLICIT NONE
C ..
C .. Scalar Arguments ..
INTEGER IREC
C ..
C .. Array Arguments ..
INTEGER*2 IARR(2)
C ..
C .. Local Scalars ..
INTEGER IRECNO
C ..
C .. Local Arrays ..
INTEGER*2 IBUF(2)
C
C .. Equivalences ..
EQUIVALENCE (IBUF(1),IRECNO)
IBUF(1) = IARR(1)
IBUF(2) = IARR(2)
IREC = IRECNO
END
C== REFLMATCH ==
C
C
C
SUBROUTINE REFLMATCH(INT,FVAR,NBIG,NSPOT,NM,IDELX,IDELY,FORCE,
+ LIMIT,VLIM,JSTEP,INTGAIN,ISDGAIN,INTLOST,
+ ISDLOST,NGAIN,NLOST,ADDPART,PTMIN)
C ===========================================================
C
C
C---- Find the intensities of reflections in the small list
C from the corresponding reflections in the big list stored
C in /REFLIST/
C
C
C
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL VLIM,PTMIN,FVAR
INTEGER IDELX,IDELY,INT,INTGAIN,INTLOST,ISDGAIN,ISDLOST,
+ JSTEP,LIMIT,NBIG,NGAIN,NLOST,NM,NSPOT
LOGICAL FORCE,ADDPART
C ..
C .. Local Scalars ..
REAL VAR,VGAIN,VLOST,XIOVSUM
INTEGER I,IB,IBF,IBMIN,IP1,IP2,IS,IXB,IXS,IYB,IYS,MODE,NPR,NRM,
+ NSUM,MEANINT
LOGICAL LAST,NOW,LLAST
C ..
C .. Local Arrays ..
INTEGER*2 IFLAG(NREFLS,2),IREFG(1000),IREFL(1000)
REAL XIOVSIG(1000)
C ..
C .. External Subroutines ..
EXTERNAL GENSORT,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MIN,MOD,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/reflist.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reflist.h
C---- START of include file reflist.h
C
C
C .. Arrays in common block /REFLIST/ ..
INTEGER XREF,YREF,INTREF,ISDREF
C ..
C .. Common Block /REFLIST/ ..
COMMON /REFLIST/XREF(NREFLS),YREF(NREFLS),INTREF(NREFLS),
+ ISDREF(NREFLS)
C ..
C
C
C&&*&& end_include ../inc/reflist.f
C ..
C .. Equivalences ..
C ..
SAVE
C
LLAST = .FALSE.
C
C---- Set pointers for tagging reflections
C
C
IP1 = MOD(JSTEP,2) + 1
IP2 = MOD(JSTEP+1,2) + 1
C
C
DO 10 IB = 1,NBIG
IFLAG(IB,IP1) = 0
10 CONTINUE
C
C---- First convert to sorted scanner coordinates
C
MODE = 6
C
C *****************************************************
CALL GENSORT(MODE,FORCE,LIMIT,VLIM,NRM,ADDPART,PTMIN,LLAST)
C *****************************************************
C
IF (DEBUG(30)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000) NRM,NSPOT
WRITE (IOUT,FMT=6000) NRM,NSPOT
END IF
C
C
IF (DEBUG(31)) THEN
NPR = MIN(NRM,20)
IF (ONLINE) WRITE (ITOUT,FMT=6002) (I,IX(I),IY(I),I=1,NPR)
WRITE (IOUT,FMT=6002) (I,IX(I),IY(I),I=1,NPR)
END IF
C
C---- Find matching reflections
C
IBMIN = 1
INT = 0
FVAR = 0.0
NM = 0
C
C
DO 50 IS = 1,NRM
IXS = IX(IS)
IYS = IY(IS)
C
C---- Set start point for search in big list
C
IBF = IBMIN
C
C
DO 20 IB = IBF,NBIG
IXB = XREF(IB)
C
C---- not far enough in big list
C
IF ((IXS-IXB).GT.IDELX) THEN
IBMIN = IB
C
C---- gone too far, no match
C
ELSE IF ((IXB-IXS).GT.IDELX) THEN
GO TO 40
ELSE
IYB = YREF(IB)
IF (ABS(IYB-IYS).LE.IDELY) GO TO 30
END IF
20 CONTINUE
GO TO 50
C
C---- Reflection matched
C
30 NM = NM + 1
IFLAG(IB,IP1) = 1
C
C
IF (ISDREF(IB).GT.0) THEN
INT = INTREF(IB) + INT
VAR = ISDREF(IB)
FVAR = VAR*VAR + FVAR
END IF
C
C
IF (DEBUG(31) .AND. NM.LT.NDEBUG(31)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6006) IS,IB,IXS,IYS,IXB,IYB,
+ INTREF(IB),ISDREF(IB)
WRITE (IOUT,FMT=6006) IS,IB,IXS,IYS,IXB,IYB,INTREF(IB),
+ ISDREF(IB)
END IF
C
C
GO TO 50
C
C
40 IF (DEBUG(31)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6004) IS,IXS,IYS,IB
WRITE (IOUT,FMT=6004) IS,IXS,IYS,IB
END IF
C
C
50 CONTINUE
C
C
IF (JSTEP.NE.1) THEN
C
C---- Find which reflections are lost and gained in this step
C relative to previous step
C
NGAIN = 0
NLOST = 0
INTGAIN = 0
VGAIN = 0
ISDGAIN = 0
ISDLOST = 0
INTLOST = 0
VLOST = 0
XIOVSUM = 0.0
MEANINT = 0
NSUM = 0
C
C
DO 60 IB = 1,NBIG
NOW = (IFLAG(IB,IP1).EQ.1)
LAST = (IFLAG(IB,IP2).EQ.1)
C
C
IF (NOW .AND. (.NOT.LAST)) THEN
NGAIN = NGAIN + 1
C
C
IF (NGAIN.GT.1000) THEN
GO TO 80
ELSE
IREFG(NGAIN) = IB
VAR = ISDREF(IB)
C
C
IF (VAR.GT.0.0) THEN
INTGAIN = INTREF(IB) + INTGAIN
VGAIN = VAR*VAR + VGAIN
XIOVSIG(NGAIN) = REAL(INTREF(IB))/VAR
XIOVSUM = XIOVSUM + XIOVSIG(NGAIN)
NSUM = NSUM + 1
END IF
C
C
END IF
ELSE IF (LAST .AND. (.NOT.NOW)) THEN
NLOST = NLOST + 1
C
C
IF (NLOST.GT.1000) THEN
GO TO 70
ELSE
IREFL(NLOST) = IB
VAR = ISDREF(IB)
C
C
IF (VAR.GT.0.0) THEN
INTLOST = INTREF(IB) + INTLOST
VLOST = VAR*VAR + VLOST
END IF
END IF
END IF
60 CONTINUE
C
C
IF (VGAIN.NE.0) ISDGAIN = SQRT(VGAIN)
IF (VLOST.NE.0) ISDLOST = SQRT(VLOST)
IF (NSUM.NE.0) THEN
XIOVSUM = XIOVSUM/NSUM
MEANINT = INTGAIN/NSUM
END IF
C
C
IF (DEBUG(30)) THEN
IF (NGAIN.GT.0) THEN
WRITE (IOUT,FMT=6010) JSTEP,NGAIN,INTGAIN,ISDGAIN,XIOVSUM,
+ MEANINT,
+ (I,IREFG(I),XREF(IREFG(I)),YREF(IREFG(I)),
+ INTREF(IREFG(I)),ISDREF(IREFG(I)),XIOVSIG(I),I=1,NGAIN)
IF (ONLINE) WRITE (ITOUT,FMT=6010) JSTEP,NGAIN,INTGAIN,
+ ISDGAIN, XIOVSUM,MEANINT,
+ (I,IREFG(I),XREF(IREFG(I)),YREF(IREFG(I)),
+ INTREF(IREFG(I)),ISDREF(IREFG(I)),
+ XIOVSIG(I),I=1,NGAIN)
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6012) JSTEP,NGAIN
WRITE (IOUT,FMT=6012) JSTEP,NGAIN
END IF
C
C
IF (NLOST.GT.0) THEN
WRITE (IOUT,FMT=6014) JSTEP,NLOST,INTLOST,ISDLOST,
+ (I,IREFL(I),INTREF(IREFL(I)),ISDREF(IREFL(I)),I=1,NLOST)
IF (ONLINE) WRITE (ITOUT,FMT=6014) JSTEP,NLOST,INTLOST,
+ ISDLOST, (I,IREFL(I),INTREF(IREFL(I)),ISDREF(IREFL(I)),
+ I=1,NLOST)
ELSE
IF (ONLINE) WRITE (ITOUT,FMT=6016) JSTEP,NLOST
WRITE (IOUT,FMT=6016) JSTEP,NLOST
END IF
END IF
C
C
RETURN
70 IF (ONLINE) WRITE (ITOUT,FMT=6008)
WRITE (IOUT,FMT=6008)
CALL SHUTDOWN
80 IF (ONLINE) WRITE (ITOUT,FMT=6008)
WRITE (IOUT,FMT=6008)
CALL SHUTDOWN
END IF
C
C---- Format statements
C
6000 FORMAT (/1X,'REFMATCH',I6,' Reflections selected by GENSORT out',
+ ' of',I5,' Generated')
6002 FORMAT (/1X,'Coordinates',/ (1X,I3,3X,2I6))
6004 FORMAT (1X,'*** ERROR *** No match for Refl',I4,' at Coords',
+ 2I6,' after searching to',I4,' in BIGLIST')
6006 FORMAT (1X,'Match IS=',I4,' to IB=',I4,' coords',2I5,' and',2I5,
+ ' INT,SD',2I6)
6008 FORMAT (//1X,'More than 1000 Reflections LOST/GAINED per STEP',
+ /,1X,'RERUN with smaller STEP SIZE')
6010 FORMAT (/1X,'STEP',I3,5X,I4,' Reflections gained,',
+ ' Total Intensity',
+ I8,' SD',I4,/,1X,'Mean I/sig(I)',F6.2,' Mean intensity',
+ ' per spot',I8,/,1X,' I IB IX IY INT',
+ ' SD I/SD',/, (1X,I3,I5,2I6,5X,2I6,F6.1))
6012 FORMAT (/1X,'STEP',I3,5X,I4,' Reflections gained')
6014 FORMAT (/1X,'STEP',I3,5X,I4,' Reflections lost, Total intensity',
+ I6,' SD',I4,/ (1X,I3,I5,2I6))
6016 FORMAT (/1X,'STEP',I3,5X,I4,' Reflections lost')
C
C
END
C== REFORT ==
C
SUBROUTINE REFORT(ISTAT)
C =======================
C
C---- Refines orientation and cell parameters
C
C
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar arguments
INTEGER ISTAT
C ..
C .. Local Scalars ..
REAL AM,ANG,COSTH,CP,CPX,CPY,DET,DIVERG,DST,DSTSQ,EH,EV,FM,PHIP,
+ PHIX,PHIY,PHIZ,PI,RC,RO,SIGRSQ,SP,SPX,SPY,TERM,TWOEPS,
+ XSQ,XX,YSQ,YY,ZSQ,ZZ,STEMP,DTOR
INTEGER I,IJ,IM,J,JJ,K,KREJ,NANG,NCYC,NNP,NPP,NPS,NPSTOR
LOGICAL LAST
C ..
C .. Local Arrays ..
REAL C(3,3),CELLX(6),CX(3,3),CY(3,3),DANG(MREF),DR(11),
+ P(3,3),PC(3,3),PCA(3,3),Q(121),S(11),X(3),R(11)
INTEGER IWRK1(11),IWRK2(11)
C ..
C .. External Subroutines ..
EXTERNAL CLEAR,MATMUL3,MATSET,MINV,RECCEL,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ASIN,ATAN,REAL,SQRT,COS,SIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/idxall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file idxall.h
C---- START of include file idxall.h
C
C ..
C .. Scalars in Common /IDXALL/ ..
REAL ANGLIM,RAPI,RMSR
INTEGER IC,ICMAX,IPRINT,NA,NC,NP,NR,NRSEG,OLDSEG,NS
LOGICAL HKL,ISYNL
C ..
C .. Arrays in Common /IDXALL/ ..
REAL F,PARM,PHI,SIG,WW,PHIIM
INTEGER IH,IK,IL,IPARPOINT
C ..
C .. Common block /IDXALL/ ..
COMMON /IDXALL/F(MREF),PARM(6+NIMAX*3+2),PHI(MREF),
$ SIG(11+NIMAX*2),WW(MREF),PHIIM(NIMAX),ANGLIM,RAPI,
+ RMSR,IH(MREF),IK(MREF),IL(MREF),IPARPOINT(NIMAX),
+ IC,ICMAX,IPRINT,NA,NC,NP,NR,NRSEG,OLDSEG,NS,HKL,ISYNL
C ..
C
C
C&&*&& end_include ../inc/idxall.f
C&&*&& include ../inc/idxcell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file idxcell.h
C---- START of include file idxcell.h
C
C ..
C ..
C .. Arrays in Common /IDXCELL/ ..
REAL DUBDCC
C ..
C .. Common blocks ..
COMMON /IDXCELL/ DUBDCC(3,3,6)
C ..
C
C
C&&*&& end_include ../inc/idxcell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C ..
SAVE
C .. Equivalences ..
EQUIVALENCE (PARM(1),PHIX), (PARM(2),PHIY), (PARM(3),PHIZ)
EQUIVALENCE (PARM(4),CELLX(1))
C ..
C
C
C
DTOR = ATAN(1.0)*4.0/180.0
C
PI = ATAN(1.0)*4.0
LAST = .FALSE.
C
C---- NC is number of cell parameters
C
NP = NC + 3
NPSTOR = NP
C
C---- On first cycle refine only orientation
C
IF (IC.EQ.1) NP = 3
NPP = NP + 1
C
IF (IPRINT.GT.0 .OR. IC.EQ.ICMAX) THEN
WRITE (IOUT,FMT=6000) IC
IF (ONLINE) WRITE (ITOUT,FMT=6000) IC
END IF
C
C---- Start cycle
C
NCYC = 0
10 CONTINUE
NCYC = NCYC + 1
C
IJ = 0
NPS = NP + NS
C
C
DO 30 I = 1,NPS
S(I) = 0.0
DO 20 J = 1,NPS
IJ = IJ + 1
Q(IJ) = 0.0
20 CONTINUE
30 CONTINUE
C
C---- Set up matrices
C
DO 50 I = 1,3
DO 40 J = 1,3
AMAT(J,I) = 0.0
DO 38 K=1,6
DUBDCC(J,I,K) = 0.0
38 CONTINUE
40 CONTINUE
50 CONTINUE
C
C **********************
CALL MATSET(CELLX,NC,IPRINT)
C **********************
C
SIGRSQ = 0.0
NANG = 0
C
C
IF (IPRINT.GT.0 .OR. LAST) THEN
WRITE (IOUT,FMT=6002) ANGLIM
IF (ONLINE) WRITE (ITOUT,FMT=6002) ANGLIM
END IF
C
IF (IPRINT.GT.0) THEN
WRITE (IOUT,FMT=6004)
IF (ONLINE) WRITE (ITOUT,FMT=6004)
END IF
C
KREJ = 0
C
CPX = COS(DTOR*PHIX)
SPX = SIN(DTOR*PHIX)
CPY = COS(DTOR*PHIY)
SPY = SIN(DTOR*PHIY)
C
C---- Loop over each reflection. Must loop over entire array, discarding
C reflections with zero F, because data for each pack is assigned the
C same amount of space in array, and there will (in general) be
C gaps between the data from adjacent packs, which can be detected by
C zero F values, as POSTREFL has a hardwired limit of 0.05 for F
C
DO 110 K = 1,MREF
IF (F(K).LT.0.001) GOTO 110
PHIP = (PHI(K)+PHIZ)
CP = COS(DTOR*PHIP)
SP = SIN(DTOR*PHIP)
C
C---- Loop over each parameter
C
DO 70 I = 1,NPP
C
C *********
CALL CLEAR(P)
CALL CLEAR(CX)
CALL CLEAR(CY)
C *********
C
C---- Set up rotation matrices
C
CX(1,1) = 1.0
CX(2,2) = CPX
CX(2,3) = -SPX
CX(3,2) = SPX
CX(3,3) = CPX
CY(1,1) = CPY
CY(1,3) = SPY
CY(2,2) = 1.0
CY(3,1) = -SPY
CY(3,3) = CPY
P(1,1) = CP
P(2,1) = SP
P(1,2) = -SP
P(2,2) = CP
P(3,3) = 1.00
IM = I
IF (I.LE.4) IM = 1
C
C
IF (I.EQ.2) THEN
C
C---- Set up derivatives
C
C *********
CALL CLEAR(CX)
C *********
C
CX(2,2) = -SPX
CX(2,3) = -CPX
CX(3,2) = CPX
CX(3,3) = -SPX
ELSE IF (I.EQ.3) THEN
C
C *********
CALL CLEAR(CY)
C *********
C
CY(1,1) = -SPY
CY(1,3) = CPY
CY(3,1) = -CPY
CY(3,3) = -SPY
ELSE IF (I.EQ.4) THEN
C
C ********
CALL CLEAR(P)
C ********
C
P(1,1) = -SP
P(2,1) = CP
P(1,2) = -CP
P(2,2) = -SP
END IF
C
C ****************
CALL MATMUL3(C,CY,CX)
CALL MATMUL3(PC,P,C)
C ****************
C
IF (IM.GE.5) IM = IM - 3
C
IF (IM.EQ.1) THEN
C ************************
CALL MATMUL3(PCA,PC,AMAT(1,1))
C ************************
ELSE
C ************************
CALL MATMUL3(PCA,PC,DUBDCC(1,1,IM-1))
C ************************
END IF
C
DO 60 J = 1,3
X(J) = PCA(J,1)*IH(K) + PCA(J,2)*IK(K) + PCA(J,3)*IL(K)
60 CONTINUE
C
C---- Skip if calculating derivatives
C
IF (I.NE.1) THEN
C
C---- Deriv of RC w.r. to relevant ptr
C
DR(I-1) = (X(1)*XX+X(1)+X(2)*YY+X(3)*ZZ)/ (RC)/DST*WW(K)
ELSE
XX = X(1)
YY = X(2)
ZZ = X(3)
XSQ = XX*XX
YSQ = YY*YY
ZSQ = ZZ*ZZ
DSTSQ = XSQ + YSQ + ZSQ
STEMP = 1.0 - DSTSQ*0.25
IF (STEMP.LT.0.0) WRITE(6,8888) STEMP
8888 FORMAT(' COSTH FROM REFORT = ',F20.10)
COSTH = SQRT(STEMP)
STEMP = DSTSQ
IF (STEMP.LT.0.0) WRITE(6,8889) STEMP
8889 FORMAT(' DST FROM REFORT = ',F20.10)
DST = SQRT(STEMP)
C
C---- Note change in next lines. If refining one beam parameter, then
C it should eb the mosaic spread, if two, then it is the beam
C divergences. This does NOT depend on whether or not the data is from
C a synchrotron.
C
IF (NS.EQ.1) THEN
PARM(10) = ETA
ELSE
PARM(10) = DIVH
PARM(11) = DIVV
END IF
EH = DIVH*ZZ
EV = DIVV*YY
C
C---- Include the beam-divergence contribution from DELCOR
C
EH = EH + DELCOR*DSTSQ
STEMP = (EH*EH + EV*EV)/ (YSQ + ZSQ)
IF (STEMP.LT.0.0) WRITE(6,8877) STEMP
8877 FORMAT(' DIVERG FROM REFORT = ',F20.10)
DIVERG = SQRT(STEMP)
C
TWOEPS = ((DIVERG+ETA)*COSTH+DELAMB*DST*0.5)*DST
C
C---- Calculate radius of point H,K,L from centre of sphere
C
STEMP = 2.0*XX + 1.0 + DSTSQ
IF (STEMP.LT.0.0) WRITE(6,8866) STEMP
8866 FORMAT(' RC FROM REFORT = ',F20.10)
RC = SQRT(STEMP)
C
C---- Correct for fraction recorded of spot
C -ve frac denotes phi-start, +ve phi-end.
C After making all fracs +ve, obsd radius of
C refln (sphere-origin) is 1-(.5-f)*eps*2 for y-ve phi-end
C or y+ve phi-start; or 1+(.5+f)*eps*2 for the other
C situations.
C
IF (YY.LT.0.0) THEN
IF (F(K).LT.0.0) THEN
AM = -F(K)
ELSE
AM = 1.0 - F(K)
END IF
ELSE IF (F(K).LT.0.0) THEN
AM = F(K) + 1.0
ELSE
AM = F(K)
END IF
C
C---- Observed radius
C Assume rocking curve is a COS function (-PI/2,+PI/2)
C
C---- Observed radius set to 1.0 for extra ref
C Put eps term in rc, assume d(rc)/dx remains the same
C
FM = 1.0 - 2.0*AM
IF (ABS(FM).GT.1.0) FM = SIGN(1.0,FM)
RO = 1.0
RC = RC - ASIN(FM)*TWOEPS/PI
C
DANG(K) = (RO-RC)/DST
ANG = DANG(K)/RAPI
IF (ABS(ANG).LT.ANGLIM) THEN
NANG = NANG + 1
SIGRSQ = DANG(K)*DANG(K) + SIGRSQ
C
C---- Skip to end of parameter loop
C
ELSE
GO TO 100
END IF
END IF
70 CONTINUE
C
C---- End of parameter loop
C
C
C---- Form least squares matrix
C
C---- Extra refinement only on second pass (IC>1)
C Set NP to NNP for ref
C
NNP = NP
IF (IC.GT.1 .AND. NS.GT.0) THEN
NNP = NP + NS
C
C---- Derivs for ETA and divergence
C
TERM = -ASIN(FM)/PI
C
C---- ETA or DIVH=DIVV
C
DR(NP+1) = TERM*COSTH*WW(K)
C
C---- DIVH and DIVV
C sqrt(GH*GH*cos*cos + GV*GV*sin*sin)d*costh where
C alpha = tan-1 yy/zz
C
IF (NS.EQ.2) THEN
DR(NP+1) = TERM*COSTH*DIVH*ZSQ/ (YSQ+ZSQ)/DIVERG*WW(K)
DR(NP+2) = TERM*COSTH*DIVV*YSQ/ (YSQ+ZSQ)/DIVERG*WW(K)
END IF
END IF
C
C
DO 90 I = 1,NNP
S(I) = DANG(K)*DR(I)*WW(K) + S(I)
C
C
DO 80 J = 1,NNP
IJ = (I-1)*NNP + J
Q(IJ) = DR(I)*DR(J) + Q(IJ)
80 CONTINUE
90 CONTINUE
C
C
GO TO 110
100 IF (IPRINT.GT.0) THEN
WRITE (IOUT,FMT=6006) IH(K),IK(K),IL(K),ANG
IF (ONLINE) WRITE (ITOUT,FMT=6006)
+ IH(K),IK(K),IL(K),ANG
END IF
C
C
KREJ = KREJ + 1
C
C---- Skip to end of reflection loop
C
110 CONTINUE
C
C---- Check no. of observations
C
IF (NANG.LE.NNP) THEN
GO TO 210
ELSE
C
C---- Solve least squares equations
C
C ***************************
CALL MINV(Q,NNP,DET,IWRK1,IWRK2)
C ***************************
C
IF (DET.EQ.0.0) THEN
GO TO 200
ELSE
IJ = 0
C
C
DO 130 I = 1,NNP
R(I) = 0
C
C
DO 120 J = 1,NNP
IJ = IJ + 1
R(I) = Q(IJ)*S(J) + R(I)
120 CONTINUE
130 CONTINUE
C
C
JJ = 1
C
C---- Reset angle limit to 3*rms deviation
C
STEMP = SIGRSQ/REAL(NANG)
IF (STEMP.LT.0.0) THEN
WRITE(IOUT,FMT=6007)
IF (ONLINE) WRITE(ITOUT,FMT=6007)
GOTO 215
END IF
C IF (STEMP.LT.0.0) WRITE (6,8855) STEMP
8855 FORMAT(' RMSR FROM REFORT = ',F20.10)
RMSR = SQRT(STEMP)
RMSR = RMSR/RAPI
IF (3.0*RMSR.LT.ANGLIM) ANGLIM = 3.0*RMSR
C
C---- Calculate standard deviations
C
DO 140 J = 1,NNP
C
C---- Test for negative diagonal element
C (can occur due to rounding errors)
C
IF (Q(JJ).LE.0.0) Q(JJ) = 0.0000001
STEMP = Q(JJ)*SIGRSQ/ (NANG-NNP)
IF (STEMP.LT.0.0) THEN
WRITE(IOUT,FMT=6007)
IF (ONLINE) WRITE(ITOUT,FMT=6007)
GOTO 215
END IF
C IF (STEMP.LT.0.0) WRITE(6,8833) STEMP
8833 FORMAT(' SIG(J) FROM REFORT = ',F20.10)
SIG(J) = SQRT(STEMP)
JJ = JJ + NNP + 1
140 CONTINUE
C
IF (IPRINT.GT.0 .OR. LAST) THEN
WRITE (IOUT,FMT=6012) KREJ
IF (ONLINE) WRITE (ITOUT,FMT=6012) KREJ
IF (BRIEF) WRITE (IBRIEF,FMT=6012) KREJ
WRITE (IOUT,FMT=6014) SIGRSQ,RMSR
IF (ONLINE) WRITE (ITOUT,FMT=6014) SIGRSQ,RMSR
IF (BRIEF) WRITE (IBRIEF,FMT=6014) SIGRSQ,RMSR
END IF
C
C---- Convert angle parameters to degrees
C
JJ = NC + 3
C
C
DO 150 I = 1,NP
IF ((I.LE.3) .OR. I.GT. (JJ-NA)) THEN
R(I) = R(I)/RAPI
SIG(I) = SIG(I)/RAPI
END IF
150 CONTINUE
C
C---- First do phi + cell only
C
IF (LAST .OR. IPRINT.GT.0) THEN
WRITE (IOUT,FMT=6016) PHIX,PHIY,PHIZ, (PARM(I),I=4,JJ)
IF (ONLINE) WRITE (ITOUT,FMT=6016) PHIX,PHIY,PHIZ,
+ (PARM(I),I=4,JJ)
IF (BRIEF) WRITE (IBRIEF,FMT=6016) PHIX,PHIY,PHIZ,
+ (PARM(I),I=4,JJ)
WRITE (IOUT,FMT=6018) (R(I),I=1,NP)
IF (ONLINE) WRITE (ITOUT,FMT=6018) (R(I),I=1,NP)
IF (BRIEF) WRITE (IBRIEF,FMT=6018) (R(I),I=1,NP)
END IF
C
C---- Add parameter shifts
C
DO 160 I = 1,NP
PARM(I) = PARM(I) + R(I)
160 CONTINUE
C
C
IF (LAST .OR. IPRINT.GT.0) THEN
WRITE (IOUT,FMT=6020) PHIX,PHIY,PHIZ, (CELLX(I),I=1,NC)
IF (ONLINE) WRITE (ITOUT,FMT=6020) PHIX,PHIY,PHIZ,
+ (CELLX(I),I=1,NC)
IF (BRIEF) WRITE (IBRIEF,FMT=6020) PHIX,PHIY,PHIZ,
+ (CELLX(I),I=1,NC)
WRITE (IOUT,FMT=6022) (SIG(J),J=1,NP)
IF (ONLINE) WRITE (ITOUT,FMT=6022) (SIG(J),J=1,NP)
IF (BRIEF) WRITE (IBRIEF,FMT=6022) (SIG(J),J=1,NP)
END IF
C
C---- Extra ref output after second pass
C
IF (NS.GT.0 .AND. IC.GT.1) THEN
C
IF (LAST .OR. IPRINT.GT.0) THEN
C
C---- Write out old params
C
IF (NS.EQ.1) THEN
WRITE (IOUT,FMT=6024)
IF (ONLINE) WRITE (ITOUT,FMT=6024)
IF (BRIEF) WRITE (IBRIEF,FMT=6024)
ELSE
WRITE (IOUT,FMT=6028)
IF (ONLINE) WRITE (ITOUT,FMT=6028)
IF (BRIEF) WRITE (IBRIEF,FMT=6028)
END IF
C
WRITE (IOUT,FMT=6030) (PARM(I+9)/RAPI,I=1,NS)
IF (ONLINE) WRITE (ITOUT,FMT=6030)
+ (PARM(I+9)/RAPI,I=1,NS)
IF (BRIEF) WRITE (IBRIEF,FMT=6030)
+ (PARM(I+9)/RAPI,I=1,NS)
WRITE (IOUT,FMT=6032) (R(I)/RAPI,I=NP+1,NP+NS)
IF (ONLINE) WRITE (ITOUT,FMT=6032)
+ (R(I)/RAPI,I=NP+1,NP+NS)
IF (BRIEF) WRITE (IBRIEF,FMT=6032)
+ (R(I)/RAPI,I=NP+1,NP+NS)
END IF
C
C---- Add parameter shifts
C
DO 170 I = 1,NS
PARM(I+9) = PARM(I+9) + R(NP+I)
170 CONTINUE
C
C
IF (NS.EQ.1) THEN
ETA = PARM(10)
ELSE
DIVH = PARM(10)
DIVV = PARM(11)
END IF
C
C---- Now write out new extra params
C
IF (LAST .OR. IPRINT.GT.0) THEN
WRITE (IOUT,FMT=6034) (PARM(I+9)/RAPI,I=1,NS)
IF (ONLINE) WRITE (ITOUT,FMT=6034)
+ (PARM(I+9)/RAPI,I=1,NS)
IF (BRIEF) WRITE (IBRIEF,FMT=6034)
+ (PARM(I+9)/RAPI,I=1,NS)
WRITE (IOUT,FMT=6036) (SIG(J)/RAPI,J=NP+1,NP+NS)
IF (ONLINE) WRITE (ITOUT,FMT=6036)
+ (SIG(J)/RAPI,J=NP+1,NP+NS)
IF (BRIEF) WRITE (IBRIEF,FMT=6036)
+ (SIG(J)/RAPI,J=NP+1,NP+NS)
END IF
C
C---- end of extra output after second pass
C
END IF
C
C---- Here if no extra refinement
C
IF (LAST) THEN
GO TO 190
ELSE
C
C---- If after first cycle of refinement too many reflexions
C are rejected return to re-index
C
IF (HKL .OR. NCYC.LE.1 .OR. KREJ.LE.NR/5) THEN
C
C---- Maximum of 5 cycles of REFORT - return to re-index
C
IF (NCYC.NE.5) THEN
C
C---- Test size of shifts
C
DO 180 I = 1,NNP
IF (ABS(R(I)/SIG(I)).GT.0.1) GO TO 10
180 CONTINUE
END IF
END IF
C
C---- If last full cycle then repeat refinement printing stats
C
IF (IC.EQ.ICMAX) THEN
LAST = .TRUE.
GO TO 10
END IF
END IF
END IF
END IF
NP = NPSTOR
RETURN
C
C---- Finish, prepare for print
C First deal with normal params
C
190 JJ = NC + 3
WRITE (IOUT,FMT=6038)
IF (ONLINE) WRITE (ITOUT,FMT=6038)
IF (BRIEF) WRITE (IBRIEF,FMT=6038)
WRITE (IOUT,FMT=6040) (PARM(I),I=1,3)
IF (ONLINE) WRITE (ITOUT,FMT=6040) (PARM(I),I=1,3)
IF (BRIEF) WRITE (IBRIEF,FMT=6040) (PARM(I),I=1,3)
C
C---- Now extras if present
C
IF (NS.GT.0) THEN
IF (NS.EQ.1) THEN
WRITE (IOUT,FMT=6024)
IF (ONLINE) WRITE (ITOUT,FMT=6024)
IF (BRIEF) WRITE (IBRIEF,FMT=6024)
ELSE
WRITE (IOUT,FMT=6028)
IF (ONLINE) WRITE (ITOUT,FMT=6028)
IF (BRIEF) WRITE (IBRIEF,FMT=6028)
END IF
C
WRITE (IOUT,FMT=6034) (PARM(I+9)/RAPI,I=1,NS)
IF (ONLINE) WRITE (ITOUT,FMT=6034) (PARM(I+9)/RAPI,I=1,NS)
IF (BRIEF) WRITE (IBRIEF,FMT=6034) (PARM(I+9)/RAPI,I=1,NS)
WRITE (IOUT,FMT=6036) (SIG(J)/RAPI,J=NP+1,NP+NS)
IF (ONLINE) WRITE (ITOUT,FMT=6036)
+ (SIG(J)/RAPI,J=NP+1,NP+NS)
IF (BRIEF) WRITE (IBRIEF,FMT=6036)
+ (SIG(J)/RAPI,J=NP+1,NP+NS)
C
C---- End of extras
C
END IF
C
C---- Call MATSET to calculate new AMAT using refined cell parameters.
C This also moves the refined cell parameters back into RCELL
C
C **********************
CALL MATSET(CELLX,NC,IPRINT)
C **********************
C
WRITE (IOUT,FMT=6042) (RCELL(I),I=1,6)
IF (ONLINE) WRITE (ITOUT,FMT=6042) (RCELL(I),I=1,6)
IF (BRIEF) WRITE (IBRIEF,FMT=6042) (RCELL(I),I=1,6)
C
C---- Real cell parameters
C
C ************************
CALL RECCEL(CELL,RCELL,WAVE)
C ************************
C
WRITE (IOUT,FMT=6044) CELL
IF (ONLINE) WRITE (ITOUT,FMT=6044) CELL
IF (BRIEF) WRITE (IBRIEF,FMT=6044) CELL
C
C---- [A] OR [UB] Matrix
C
WRITE (IOUT,FMT=6046) ((AMAT(I,J),J=1,3),
+ (UMAT(I,J),J=1,3),I=1,3)
IF (ONLINE) WRITE (ITOUT,FMT=6046) ((AMAT(I,J),J=1,3),
+ (UMAT(I,J),J=1,3),I=1,3)
RETURN
200 WRITE (IOUT,FMT=6010)
IF (ONLINE) WRITE (ITOUT,FMT=6010)
IF (BRIEF) WRITE (IBRIEF,FMT=6010)
GOTO 215
210 WRITE (IOUT,FMT=6008)
IF (ONLINE) WRITE (ITOUT,FMT=6008)
IF (BRIEF) WRITE (IBRIEF,FMT=6008)
215 WRITE (IOUT,FMT=6011)
IF (ONLINE) WRITE (ITOUT,FMT=6011)
CALL SHUTDOWN
C
C---- Format statements
C
6000 FORMAT (1X,16 ('+++++'),//10X,'PARAMETER REFINEMENT PASS',I3)
6002 FORMAT (/' Reflections rejected if angular error >',F6.2,' deg.',
+ /)
6004 FORMAT (/7X,'H K L ANGERR(degrees) ')
6006 FORMAT (4X,3I4,F7.2)
6007 FORMAT (/,1X,'*** Ill determined normal matrix ***')
6008 FORMAT ('*** Fewer data than parameters ***')
6010 FORMAT (/6X,'Singular equations ')
6011 FORMAT (/,1X,'There is insufficient',
+ ' data to refine all the parameters',/,1X,
+ 'This can happen if you are using far too small a value',
+ ' for the mosaic spread.',/,1X,
+ 'If you are using the refined beam parameters (USEBEAM) ',
+ 'first check that the',/,1X,'divergence (or mosaicity) ',
+ 'has not refined to either too large or ',
+ 'too small a value. If not the case',/,1X,'Try using ',
+ ' more images by increasing WIDTH or NADD (POSTREF',
+ ' keyword)',/,1X,'or FIX some or ALL cell parameters.')
6012 FORMAT (' Number of reflections rejected: ',I5)
6014 FORMAT (' Sum of (RO-RC)/D*)SQD = ',F12.8,' Rms residual = ',F8.3,
+ ' degrees')
6016 FORMAT (/11X,'PHIX PHIY PHIZ Refined ,reciprocal ce',
+ 'll parameters',/' Old ',3F10.3,3F10.6,3F10.4)
6018 FORMAT (' Shifts',3F10.3,3F10.6,3F10.4)
6020 FORMAT (' New ',3F10.3,3F10.6,3F10.4)
6022 FORMAT (' S.D. ',3F10.3,3F10.6,3F10.4)
6024 FORMAT (/10X,'Mosaic spread')
6028 FORMAT (/10X,'DIVH DIVV (Horizontal and vertical beam',
+ ' divergences)')
6030 FORMAT (' Old ',2F8.3)
6032 FORMAT (' Shifts',2F8.3)
6034 FORMAT (' New ',2F8.3)
6036 FORMAT (' S.D. ',2F8.3)
6038 FORMAT (/12X,'Refined Orientation Angles',/10X,'PHIX PHIY ',
+ ' PHIZ')
6040 FORMAT (7X,3F10.3)
6042 FORMAT (/10X,'Reciprocal cell parameters',/5X,3F10.6,3F10.3)
6044 FORMAT (/10X,'Real cell parameters',/5X,6F10.3)
6046 FORMAT (//5X,'Orientation Matrix [A] or [UB]',15X,'Matrix [U]',
+ 3 (/5X,3F10.6,5X,3F10.6))
C
C
END
C== REFRT1 ==
C
C
SUBROUTINE REFRT1(NADD,NPOINT,NIMAG,NOREFCELL,NEWPREF,ISTAT)
C ===========================================================
IMPLICIT NONE
C
C DEBUG(40) this subroutine
C
C---- Refines orientation and cell parameters
C either when data from only one image available or
C if the missetting angles are refined separately for several images.
C In these cases, the missetting angle around the X-ray beam (PSIX)
C is not refined as it is not determined.
C
C Modifications to allow several images Feb 1992.
C
C Correct formulation of weighting in least squares. This will not
C have any effect as in practice unit weights are always used.
C 2nd June 1994
C
C NADD.... For old-style post refinement:
C Number of images to be added together for use in
C post-refinement. Note than when NADD>1 but NIMAG1 but NIMAG',F6.2,' deg.',
+ /)
6004 FORMAT (/7X,'H K L ANGERR(degrees) ')
6006 FORMAT (4X,3I4,F7.2)
6007 FORMAT (/,1X,'*** Ill determined normal matrix ***',/,1X,
+ 'Variable',I3,' Diag element of inverse matrix',E10.3,
+ /,1X,'SIGRSQ',E10.5,' NANG',I5,' NNP',I3)
6008 FORMAT (/,1X,'*** Fewer data than parameters ***',/,
$ 'NANG = ',I6,' and NNP = ',I6)
6009 FORMAT (/,1X,'*** Ill determined normal matrix ***',/,1X,
+ 'SIGRSQ',F12.6,' NANG',I8)
6010 FORMAT (/,1X,'*** Singular equations ***')
6011 FORMAT (/,1X,'There are insufficient',
+ ' data to refine all the parameters sensibly',/,1X,
+ 'This can happen if you are using far too small a value',
+ ' for the mosaic spread.',/,1X,
+ 'Alternatively if you have only weak low resolution data',
+ ', cell parameters',/,1X,'may not be well defined even',
+ ' if you have a large number of reflections.',/,1X,
+ 'This will result in excessive parameter shifts which',
+ ' will lead to the',/,1X,'rejection of many ',
+ 'reflections.',/,1X,
+ 'If you are using the refined beam parameters (USEBEAM) ',
+ 'first check that the',/,1X,'divergence (or mosaicity) ',
+ 'has not refined to either too large or ',
+ 'too small',/,1X,'a value.',/,1X,
+ 'If not the case try using ',
+ ' more images by increasing WIDTH or ',/,1X,
+ 'NADD (POSTREF',
+ ' keyword)',/,1X,'or FIX some or ALL cell parameters.')
6012 FORMAT (' Number of reflections rejected: ',I5)
6014 FORMAT (' Sum of (RO-RC)/D*)**2 = ',F12.8,' Rms Resid = ',F8.3,
+ ' degrees')
6015 FORMAT (' Rms Resid = ',F8.3,' degrees')
6016 FORMAT (/11X,'PSIX PSIY PSIZ Refined reciprocal ce',
+ 'll parameters',/' Old ',3F10.3,3F10.6,3F10.4)
6018 FORMAT (' Shifts',10X,2F10.3,3F10.6,3F10.4)
6020 FORMAT (' New ',3F10.3,3F10.6,3F10.4)
6022 FORMAT (' S.D.',11X,2F10.3,3F10.6,3F10.4)
6024 FORMAT (/9X,'Mosaic spread')
6028 FORMAT (/10X,'DIVH DIVV (Horizontal and vertical beam',
+ ' divergences)')
6030 FORMAT (' Old ',2F8.3)
6032 FORMAT (' Shifts',2F8.3)
6034 FORMAT (' New ',2F8.3)
6036 FORMAT (' S.D. ',2F8.3)
6055 FORMAT(//,1X,'Inverse Normal',
+ ' matrix',/,(1X,8E10.3,/))
END
C== REFSOR ==
SUBROUTINE REFSOR(IA,NREF,NKEY,IDIM)
C ====================================
C
implicit none
C
C
C This subroutine is used to sort the reflection data held in core. It
C is a modified version of the subroutine 'AHVSOR' from eleanor dodson's
C version of the program 'CAD'
C
C
C---- Parameters
C
C IA (I/O) INTEGER ARRAY CONTAINING THE REFLECTION DATA KEYS
C NKEY KEYS FOR REFLN 1 FOLLOWED BY NKEY KEYS FOR EACH
C REFLECTION UP TO NREF REFLECTIONS (MAX OF 10 )
C NREF (I) THE NO. OF REFLECTIONS TO BE SORTED
C NKEY (I) NUMBER OF SORT KEYS (INCLUDING THE POSITION INDEX AS
C THE LAST KEY
C IDIM (I) THE NUMBER OF ELEMENTS IN THE ARRAY IA
C
C---- Specification statements
C
C .. Scalar Arguments ..
INTEGER IDIM,NKEY,NREF
C ..
C .. Array Arguments ..
INTEGER*2 IA(IDIM)
C ..
C .. Local Scalars ..
INTEGER BOTTOM,CHUNK,CUTOFF,DOWN,HIGH,I,ITEMP,J,J1,J2,
+ LOW,M,MIDDLE,MIN,MM,MMM,N,STACK,TOP,UP
C ..
C .. Local Arrays ..
INTEGER*2 CUT(10)
INTEGER SAVE(2,16)
C ..
C .. External Functions ..
INTEGER ICMP
EXTERNAL ICMP
C ..
C .. Data statements ..
DATA CUTOFF/20/
C ..
C
C---- Sort data
C
STACK = 0
LOW = 1
HIGH = NREF
10 CONTINUE
CHUNK = HIGH - LOW
C
C
IF (CHUNK.GT.CUTOFF) THEN
MIDDLE = (LOW+HIGH)/2
C
C ***************************
IF (ICMP(IA,LOW,IA,MIDDLE,NKEY).GT.0) THEN
C ***************************
C
J1 = (LOW-1)*NKEY
J2 = (MIDDLE-1)*NKEY
C
C
DO 20 I = 1,NKEY
J1 = J1 + 1
J2 = J2 + 1
ITEMP = IA(J1)
IA(J1) = IA(J2)
IA(J2) = ITEMP
20 CONTINUE
C
C
END IF
C
C ***************************
IF (ICMP(IA,MIDDLE,IA,HIGH,NKEY).GT.0) THEN
C ***************************
C
J1 = (MIDDLE-1)*NKEY
J2 = (HIGH-1)*NKEY
C
C
DO 30 I = 1,NKEY
J1 = J1 + 1
J2 = J2 + 1
ITEMP = IA(J1)
IA(J1) = IA(J2)
IA(J2) = ITEMP
30 CONTINUE
C
C **************************
IF (ICMP(IA,LOW,IA,MIDDLE,NKEY).GT.0) THEN
C **************************
C
J1 = (LOW-1)*NKEY
J2 = (MIDDLE-1)*NKEY
C
C
DO 40 I = 1,NKEY
J1 = J1 + 1
J2 = J2 + 1
ITEMP = IA(J1)
IA(J1) = IA(J2)
IA(J2) = ITEMP
40 CONTINUE
C
C
END IF
END IF
C
J = (MIDDLE-1)*NKEY
C
C
DO 50 I = 1,NKEY
J = J + 1
CUT(I) = IA(J)
50 CONTINUE
C
C
UP = LOW
DOWN = HIGH
60 CONTINUE
DOWN = DOWN - 1
C
C ***********************
IF (ICMP(CUT,1,IA,DOWN,NKEY).LT.0) THEN
C ***********************
C
GO TO 60
ELSE
70 CONTINUE
UP = UP + 1
C
C **********************
IF (ICMP(CUT,1,IA,UP,NKEY).GT.0) GO TO 70
C **********************
C
IF (UP-DOWN) 80,100,110
80 J1 = (UP-1)*NKEY
J2 = (DOWN-1)*NKEY
C
C
DO 90 I = 1,NKEY
J1 = J1 + 1
J2 = J2 + 1
ITEMP = IA(J1)
IA(J1) = IA(J2)
IA(J2) = ITEMP
90 CONTINUE
C
C
GO TO 60
END IF
C
C
100 DOWN = DOWN - 1
UP = UP + 1
110 STACK = STACK + 1
C
C
IF (STACK.LE.16) THEN
BOTTOM = DOWN - LOW
TOP = HIGH - UP
IF (BOTTOM.GT.TOP) THEN
SAVE(1,STACK) = LOW
SAVE(2,STACK) = DOWN
LOW = UP
ELSE
SAVE(1,STACK) = UP
SAVE(2,STACK) = HIGH
HIGH = DOWN
END IF
C
GO TO 10
END IF
ELSE
IF (CHUNK.GE.2) THEN
MM = HIGH - 1
C
C
DO 140 M = LOW,MM
MIN = M
MMM = M + 1
C
C
DO 120 N = MMM,HIGH
C
C *********************
IF (ICMP(IA,MIN,IA,N,NKEY).GT.0) MIN = N
C *********************
C
120 CONTINUE
C
C
IF (MIN.NE.M) THEN
J1 = (M-1)*NKEY
J2 = (MIN-1)*NKEY
C
C
DO 130 I = 1,NKEY
J1 = J1 + 1
J2 = J2 + 1
ITEMP = IA(J1)
IA(J1) = IA(J2)
IA(J2) = ITEMP
130 CONTINUE
C
C
END IF
140 CONTINUE
END IF
C
C
IF (STACK.EQ.0) THEN
RETURN
ELSE
LOW = SAVE(1,STACK)
HIGH = SAVE(2,STACK)
STACK = STACK - 1
GO TO 10
END IF
END IF
C
C---- Error condition
C
C ****************************************************
CALL CCPERR(1,'**STACK LIMIT OF 16 EXCEEDED IN REFSOR**')
C ****************************************************
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== REPORT ==
SUBROUTINE REPORT(NBOXES,USEOVRLD)
C ==================================
C
C
C
IMPLICIT NONE
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER NBOXES
LOGICAL USEOVRLD
C ..
C .. Local Scalars ..
REAL DENOM,RFAC,RFDENOM,RFNUM,RPDENOM,RPNUM,SUMBG,SUMPK,SUMSD
INTEGER I,J,JF,JS,K,KK,N,N1,N2,NCOL,NR,NRMAXI,NTOTR
LOGICAL PRFLOC
C ..
C .. Local Arrays ..
REAL RFACT(NMASKS,2)
INTEGER IAVINTI1(10),IAVPRI1(10),IRMSDELI1(10),IABSDELI1(10),
+ IAVSIG1(10),IAVPRSIG1(10),IAVDELSIG1(10),ISIGVSM(13)
character xmlline*1024
C ..
C .. External Subroutines ..
EXTERNAL MPAUSE, lenstr
integer lenstr
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MIN,NINT,REAL,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C ..
SAVE
C
PRFLOC = (NBOXES.NE.0)
C
C
WRITE (IOUT,FMT=6000) NREF-NSPOVL,NOFR,NOLO,NEDGE,NULLPIX,NEDGE1
6000 FORMAT (//,1X,I5,' Spots measured on this image',/,1X,I5,' are',
+' fully recorded,',I5,' are OVERLOADS',I5,' Outside active area',
+ /,1X,'Reflections "Outside active area" are those with pixel ',
+ 'values less than or equal to',I5,/,1X,'This value can be ',
+ 'changed with keyword NULLPIX.',
+ /,1X,I3,' Reflections partially outside the scan have been ',
+ 'profile fitted.')
IF (NSUMPART.GT.0) THEN
WRITE(IOUT,FMT=6060) NSUMPART,NHALF
IF (ONLINE) WRITE(ITOUT,FMT=6060) NSUMPART,NHALF
6060 FORMAT(1X,'There were',I6,' summed partials and of these',
+ I5,' were rejected because',/,1X,'the other half of',
+ ' the partial could not be obtained')
END IF
IF (NSPOVL.GT.0) THEN
WRITE(IOUT,FMT=6003) NSPOVL
IF (ONLINE) WRITE(ITOUT,FMT=6003) NSPOVL
IF (BRIEF) WRITE(IBRIEF,FMT=6003) NSPOVL
END IF
6003 FORMAT(1X,I5,' Spatially overlapped summed partials have been',
+ ' rejected')
IF (ONLINE) WRITE (ITOUT,FMT=6000) NREF-NSPOVL,NOFR,NOLO,NEDGE,
+ NULLPIX,NEDGE1
IF (BRIEF) WRITE (IBRIEF,FMT=6000) NREF-NSPOVL,NOFR,NOLO,NEDGE,
+ NULLPIX,NEDGE1
IF (USEOVRLD) THEN
WRITE(IOUT,6001)
IF (ONLINE) WRITE(ITOUT,6001)
IF (BRIEF) WRITE(IBRIEF,6001)
END IF
6001 FORMAT(1X,'The intensities of overloaded reflections have ',
+ 'been estimated by profile fitting')
C
C
IF (NBZERO.NE.0) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6002) NBZERO
IF (BRIEF) WRITE (IBRIEF,FMT=6002) NBZERO
6002 FORMAT (I5,' SPOTS with zero background')
WRITE (IOUT,FMT=6002) NBZERO
END IF
C
C
IF (NBOX.NE.0) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6004) NBOX
IF (BRIEF) WRITE (IBRIEF,FMT=6004) NBOX
6004 FORMAT (I5,' SPOTS with overlarge boxes')
WRITE (IOUT,FMT=6004) NBOX
END IF
C
C
WRITE (IOUT,FMT=6006) IRANGE
6006 FORMAT (/' Analysis of Intensities (Binned on integrated ',
+ 'intensities.)',/,1X,'SDI is summation integration ',
+ 'sigma(I), SDP is profile fitted sigma(I)',/,1X,
+ ' RANGES ',I6,I5,1X,3I6,1X,4I6)
WRITE (IOUT,FMT=6008) IANAL
6008 FORMAT (' NO. ',10I6)
WRITE (IOUT,FMT=6010) RATIO
6010 FORMAT (' BGRATIO',10F6.1)
WRITE (IOUT,FMT=6012) PKRATIO
6012 FORMAT (' PKRATIO',10F6.1)
WRITE (IOUT,FMT=6014) AVSD
IF (PRFLOC) WRITE (IOUT,FMT=6015) AVSDP
6014 FORMAT (1X,' ',10F6.0)
6015 FORMAT (1X,' ',10F6.0)
WRITE (IOUT,FMT=6016) MAXBSI,MINBSI
6016 FORMAT (/' Maximum Intensity=',I7,/' Minimum Intensity=',I7)
C
C
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6006) IRANGE
WRITE (ITOUT,FMT=6008) IANAL
WRITE (ITOUT,FMT=6010) RATIO
WRITE (ITOUT,FMT=6012) PKRATIO
WRITE (ITOUT,FMT=6014) AVSD
IF (PRFLOC) WRITE (ITOUT,FMT=6015) AVSDP
WRITE (ITOUT,FMT=6016) MAXBSI,MINBSI
END IF
IF (BRIEF) THEN
WRITE (IBRIEF,FMT=6006) IRANGE
WRITE (IBRIEF,FMT=6008) IANAL
WRITE (IBRIEF,FMT=6010) RATIO
WRITE (IBRIEF,FMT=6012) PKRATIO
WRITE (IBRIEF,FMT=6014) AVSD
IF (PRFLOC) WRITE (IBRIEF,FMT=6015) AVSDP
WRITE (IBRIEF,FMT=6016) MAXBSI,MINBSI
IF (.NOT.GRAPH) THEN
CALL MPAUSE
END IF
END IF
C
C---- Statistics on I/sigma as a function of resolution
C
WRITE(IOUT,FMT=6051)
IF (PRFLOC) WRITE(IOUT,FMT=6052)
+ (DBIN(I),I=1,8),(NRESPF(I),I=1,9),
+ (IRESPF(I),I=1,9),(ISDRESPF(I),I=1,9),
+ (FIOVSDP(I),I=1,9),(NRESPP(I),I=1,9),
+ (IRESPP(I),I=1,9),(ISDRESPP(I),I=1,9),
+ (PIOVSDP(I),I=1,9)
WRITE(IOUT,FMT=6053) (DBIN(I),I=1,8),(NRESSF(I),I=1,9),
+ (IRESSF(I),I=1,9),(ISDRESSF(I),I=1,9),
+ (FIOVSDS(I),I=1,9),(NRESSP(I),I=1,9),
+ (IRESSP(I),I=1,9),(ISDRESSP(I),I=1,9),
+ (PIOVSDS(I),I=1,9)
6051 FORMAT(/,1X,'Analysis as a function of resolution.')
6052 FORMAT(1X,'Res (Ang)',8F7.2,' Overall'/,
+ 1X,'Profile fitted fully recorded:',/,
+ 1X,'Number ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',F6.1,8F7.1,/,
+ 1X,'Profile fitted partials:',/,
+ 1X,'Number ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',F6.1,8F7.1)
6053 FORMAT(/,1X,'Summation integration fully recorded:',/,
+ 1X,'Res (Ang)',8F7.2,' Overall'/,
+ 1X,'Number ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',F6.1,8F7.1,/,
+ 1X,'Summation integration partials',/,
+ 1X,'Number ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',9I7,/,
+ 1X,' ',F6.1,8F7.1)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=6051)
IF (PRFLOC) WRITE(ITOUT,FMT=6052)
+ (DBIN(I),I=1,8),(NRESPF(I),I=1,9),
+ (IRESPF(I),I=1,9),(ISDRESPF(I),I=1,9),
+ (FIOVSDP(I),I=1,9),(NRESPP(I),I=1,9),
+ (IRESPP(I),I=1,9),(ISDRESPP(I),I=1,9),
+ (PIOVSDP(I),I=1,9)
END IF
IF (BRIEF) THEN
WRITE(IBRIEF,FMT=6051)
IF (PRFLOC) WRITE(IBRIEF,FMT=6052)
+ (DBIN(I),I=1,8),(NRESPF(I),I=1,9),
+ (IRESPF(I),I=1,9),(ISDRESPF(I),I=1,9),
+ (FIOVSDP(I),I=1,9),(NRESPP(I),I=1,9),
+ (IRESPP(I),I=1,9),(ISDRESPP(I),I=1,9),
+ (PIOVSDP(I),I=1,9)
END IF
IF (BRIEF.AND.(.NOT.GRAPH)) CALL MPAUSE
IF (ONLINE) WRITE(ITOUT,FMT=6053)
+ (DBIN(I),I=1,8),(NRESSF(I),I=1,9),
+ (IRESSF(I),I=1,9),(ISDRESSF(I),I=1,9),
+ (FIOVSDS(I),I=1,9),(NRESSP(I),I=1,9),
+ (IRESSP(I),I=1,9),(ISDRESSP(I),I=1,9),
+ (PIOVSDS(I),I=1,9)
IF (BRIEF) WRITE(IBRIEF,FMT=6053)
+ (DBIN(I),I=1,8),(NRESSF(I),I=1,9),
+ (IRESSF(I),I=1,9),(ISDRESSF(I),I=1,9),
+ (FIOVSDS(I),I=1,9),(NRESSP(I),I=1,9),
+ (IRESSP(I),I=1,9),(ISDRESSP(I),I=1,9),
+ (PIOVSDS(I),I=1,9)
IF ((BRIEF).AND.(.NOT.GRAPH)) CALL MPAUSE
C
C---- Statistics on intensity vs partiality
C
DO 10 I = 1,13
NR = NIVSM(I)
C
C
IF (NR.NE.0) THEN
IVSM(I) = IVSM(I)/NR
ISIGVSM(I) = NINT(SQRT(RSIGVSM(I)/NR))
END IF
C
C
10 CONTINUE
C
C
IF (ONLINE) WRITE (ITOUT,FMT=6018) (IVSM(K),K=1,7),
+ (ISIGVSM(K),K=1,7),(NIVSM(K),K=1,7),(IVSM(K),K=8,13),
+ (ISIGVSM(K),K=8,13),(NIVSM(K),K=8,13)
6018 FORMAT (//1X,'Intensity as a function of PARTIALITY',/1X,'%age R',
+ 'ecorded 5 10 15 20 30 40 50',
+ /1X,'IMEAN',7X,7I6,/1X,'SIGMA(IMEAN)',
+ 7I6,/1X,'NUMBER',6X,7I6,/,/,1X,'%age recorded 60',
+ ' 70 80 90 100 FULL',
+ /1X,'IMEAN',7X,6I6,/1X,'SIGMA(IMEAN)',
+ 6I6,/1X,'NUMBER',6X,6I6)
WRITE (IOUT,FMT=6018) (IVSM(K),K=1,7),
+ (ISIGVSM(K),K=1,7),(NIVSM(K),K=1,7),(IVSM(K),K=8,13),
+ (ISIGVSM(K),K=8,13),(NIVSM(K),K=8,13)
C
C---- Statistics on background point rejection
C
KK = 6
DO 30 K=1,5
KK = KK +2
NBGRHIST(K+7) = NBGRHIST(KK) + NBGRHIST(KK+1)
30 CONTINUE
NBGRHIST(13) = 0
DO 31 K=18,21
NBGRHIST(13) = NBGRHIST(13) + NBGRHIST(K)
31 CONTINUE
NBGRHIST(14) = 0
DO 32 K=22,26
NBGRHIST(14) = NBGRHIST(14) + NBGRHIST(K)
32 CONTINUE
NBGRHIST(15) = 0
DO 33 K=27,31
NBGRHIST(15) = NBGRHIST(15) + NBGRHIST(K)
33 CONTINUE
NBGRHIST(16) = NBGRHIST(32)
C
WRITE (IOUT,FMT=6020) (NBGRHIST(I),I=1,16)
6020 FORMAT (//1X,'Histogram of rejected points',/1X,'The number of ',
+ 'reflections having a given number of background points ',
+ 'rejected',/1X,'Number of points rejected 0 5 10 15',
+ ' 20 25 30 40 50 60 70 80 100 125 150 200',/26X,
+ 16I4,/)
IF (ONLINE) WRITE (ITOUT,FMT=6020) (NBGRHIST(I),I=1,16)
C
C---- Statistics for summary file
C
NNEG = IANAL(1) + IANAL(2)
SUMSD = 0.0
SUMBG = 0.0
SUMPK = 0.0
NTOTR = 0
C
C
DO 40 I = 1,10
NTOTR = NTOTR + IANAL(I)
SUMSD = AVSD(I)*IANAL(I) + SUMSD
SUMPK = PKRATIO(I)*IANAL(I) + SUMPK
SUMBG = RATIO(I)*IANAL(I) + SUMBG
40 CONTINUE
C
C
IF (NTOTR.NE.0) THEN
AVBGRATIO = SUMBG/ NTOTR
NBGRJ = NINT(REAL(NBGRJ)/REAL(NTOTR))
END IF
C
C----Determine bgratio and pkratio for strongest bins
C containing at least 50 reflections
C
SUMPK = 0.0
SUMBG = 0.0
NRMAXI = 0
C
C
DO 50 I = 10,1,-1
NRMAXI = IANAL(I) + NRMAXI
SUMPK = PKRATIO(I)*IANAL(I) + SUMPK
SUMBG = RATIO(I)*IANAL(I) + SUMBG
IF (NRMAXI.GE.50) GO TO 60
50 CONTINUE
C
C
60 IF (NRMAXI.NE.0) THEN
PKRMAXI = SUMPK/NRMAXI
BGRMAXI = SUMBG/NRMAXI
END IF
C
C
IF (NBOXES.NE.0) THEN
C
C----Statistics on comparison of profile fitted and integrated
C intensities
C
DO 80 J = 1,2
DO 70 I = 1,NMASKS
RFACT(I,J) = 0.0
70 CONTINUE
80 CONTINUE
C
C
RFULL = 0.0
RPART = 0.0
RFNUM = 0.0
RFDENOM = 0.0
RPNUM = 0.0
RPDENOM = 0.0
C
C---- First intensity ranges
C
DO 100 I = 1,10
DO 90 J = 1,2
N = NRFLS1(I,J)
C
C
IF (N.NE.0) THEN
IF (J.EQ.1) THEN
RFNUM = ABSDELI1(I,J) + RFNUM
RFDENOM = (AVINTI1(I,J)+AVPRI1(I,J))*0.5 + RFDENOM
ELSE
RPNUM = ABSDELI1(I,J) + RPNUM
RPDENOM = (AVINTI1(I,J)+AVPRI1(I,J))*0.5 + RPDENOM
END IF
C
C
AVINTI1(I,J) = AVINTI1(I,J)/N
AVPRI1(I,J) = AVPRI1(I,J)/N
RMSDELI1(I,J) = SQRT(RMSDELI1(I,J)/N)
ABSDELI1(I,J) = ABSDELI1(I,J)/N
MEANDELI1(I,J) = MEANDELI1(I,J)/N
DENOM = ((ABS(AVINTI1(I,J))+ABS(AVPRI1(I,J)))*0.5)
IF (DENOM.NE.0.0) RFAC = 100*ABSDELI1(I,J)/DENOM
RFACT(I,J) = MIN(RFAC,999.0)
AVSIG1(I,J) = AVSIG1(I,J)/N
AVPRSIG1(I,J) = AVPRSIG1(I,J)/N
AVDELSIG1(I,J) = AVDELSIG1(I,J)/N
END IF
90 CONTINUE
100 CONTINUE
C
C
IF (RFDENOM.NE.0.0) RFULL = 100.0*RFNUM/RFDENOM
IF (RPDENOM.NE.0.0) RPART = 100.0*RPNUM/RPDENOM
C
WRITE (IOUT,FMT=6022) RFULL,RPART
6022 FORMAT (/,1X,'RFACTOR between profile fitted and ',
+ 'summation integration intensities',/,1X,'For FULLS',
+ F5.1,2X,'for PARTIALS',F5.1)
IF (ONLINE) WRITE (ITOUT,FMT=6022) RFULL,RPART
IF (BRIEF) WRITE (IBRIEF,FMT=6022) RFULL,RPART
C
C
IF (LPRINT(4)) THEN
WRITE (IOUT,FMT=6024)
6024 FORMAT (//1X,'Analysis of differences in PROFILE FITTED and INTE',
+ 'GRATED INTENSITIES',//1X,'As a function of intensity')
IF (ONLINE) WRITE (ITOUT,FMT=6024)
NCOL = 10
C
C
DO 110 J = 1,2
DO 111 I=1,10
IAVINTI1(I) = AVINTI1(I,J)
IAVPRI1(I) = AVPRI1(I,J)
IRMSDELI1(I) = RMSDELI1(I,J)
IABSDELI1(I) = ABSDELI1(I,J)
IAVSIG1(I) = AVSIG1(I,J)
IAVPRSIG1(I) = AVPRSIG1(I,J)
IAVDELSIG1(I) = AVDELSIG1(I,J)
111 CONTINUE
IF (J.EQ.1) THEN
WRITE (IOUT,FMT=6026)
6026 FORMAT (/1X,'Analysis of FULLY recorded reflections')
IF (ONLINE) WRITE (ITOUT,FMT=6026)
ELSE
WRITE (IOUT,FMT=6028)
6028 FORMAT (//1X,'Analysis of PARTIALLY recorded reflections')
IF (ONLINE) WRITE (ITOUT,FMT=6028)
END IF
C
C
WRITE (IOUT,FMT=6030) (NRFLS1(I,J),I=1,10)
6031 FORMAT (/1X,'Box number',I5,9I7)
6030 FORMAT (1X,'Number ',10I7)
WRITE (IOUT,FMT=6032) (IAVINTI1(I),I=1,10)
6032 FORMAT (1X,' ',10I7)
WRITE (IOUT,FMT=6034) (IAVPRI1(I),I=1,10)
6034 FORMAT (1X,' ',10I7)
WRITE (IOUT,FMT=6036) (IRMSDELI1(I),I=1,10)
6036 FORMAT (1X,'Rms Diff',10I7)
WRITE (IOUT,FMT=6038) (IABSDELI1(I),I=1,10)
6038 FORMAT (1X,'',I5,9I7)
WRITE (IOUT,FMT=6040) (MEANDELI1(I,J),I=1,10)
6040 FORMAT (1X,' ',10I7)
WRITE (IOUT,FMT=6042) (RFACT(I,J),I=1,10)
6042 FORMAT (1X,'R FACTOR',10F7.1)
WRITE (IOUT,FMT=6044) (IAVSIG1(I),I=1,10)
6044 FORMAT (1X,'',I4,9I7)
WRITE (IOUT,FMT=6046) (IAVPRSIG1(I),I=1,10)
6046 FORMAT (1X,'',I4,9I7)
WRITE (IOUT,FMT=6048) (IAVDELSIG1(I),I=1,10)
6048 FORMAT (1X,' ',10I7)
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6030) (NRFLS1(I,J),I=1,10)
WRITE (ITOUT,FMT=6032) (IAVINTI1(I),I=1,10)
WRITE (ITOUT,FMT=6034) (IAVPRI1(I),I=1,10)
WRITE (ITOUT,FMT=6036) (IRMSDELI1(I),I=1,10)
WRITE (ITOUT,FMT=6038) (IABSDELI1(I),I=1,10)
WRITE (ITOUT,FMT=6040) (MEANDELI1(I,J),I=1,10)
WRITE (ITOUT,FMT=6042) (RFACT(I,J),I=1,10)
WRITE (ITOUT,FMT=6044) (IAVSIG1(I),I=1,10)
WRITE (ITOUT,FMT=6046) (IAVPRSIG1(I),I=1,10)
WRITE (ITOUT,FMT=6048) (IAVDELSIG1(I),I=1,10)
END IF
110 CONTINUE
C
C---- Now on measurement boxes
C
DO 130 J = 1,2
DO 120 I = 1,NMASKS
RFACT(I,J) = 0.0
120 CONTINUE
130 CONTINUE
C
C
DO 150 I = 1,NBOXES
DO 140 J = 1,2
N = NRFLS2(I,J)
C
C
IF (N.NE.0) THEN
AVINTI2(I,J) = AVINTI2(I,J)/N
AVPRI2(I,J) = AVPRI2(I,J)/N
RMSDELI2(I,J) = SQRT(RMSDELI2(I,J)/N)
ABSDELI2(I,J) = ABSDELI2(I,J)/N
MEANDELI2(I,J) = MEANDELI2(I,J)/N
DENOM = ((ABS(AVINTI2(I,J))+ABS(AVPRI2(I,J)))*0.5)
IF (DENOM.NE.0.0) RFAC = 100*ABSDELI2(I,J)/DENOM
RFACT(I,J) = MIN(RFAC,999.0)
AVSIG2(I,J) = AVSIG2(I,J)/N
AVPRSIG2(I,J) = AVPRSIG2(I,J)/N
AVDELSIG2(I,J) = AVDELSIG2(I,J)/N
END IF
140 CONTINUE
150 CONTINUE
C
C
WRITE (IOUT,FMT=6050)
6050 FORMAT (///1X,'Analysis as a function of BOX Number')
IF (ONLINE) WRITE (ITOUT,FMT=6050)
C
C
DO 170 J = 1,2
IF (J.EQ.1) THEN
WRITE (IOUT,FMT=6026)
IF (ONLINE) WRITE (ITOUT,FMT=6026)
ELSE
WRITE (IOUT,FMT=6028)
IF (ONLINE) WRITE (ITOUT,FMT=6028)
END IF
C
C---- Write out results in blocks of 10
C
N1 = 1
N2 = MIN(NBOXES,10)
NCOL = N2 - N1 + 1
160 CONTINUE
C
DO 161 I=1,NCOL
IAVINTI1(I) = AVINTI2(I+N1-1,J)
IAVPRI1(I) = AVPRI2(I+N1-1,J)
IRMSDELI1(I) = RMSDELI2(I+N1-1,J)
IABSDELI1(I) = ABSDELI2(I+N1-1,J)
IAVSIG1(I) = AVSIG2(I+N1-1,J)
IAVPRSIG1(I) = AVPRSIG2(I+N1-1,J)
IAVDELSIG1(I) = AVDELSIG2(I+N1-1,J)
161 CONTINUE
C
WRITE (IOUT,FMT=6031) (I,I=N1,N2)
WRITE (IOUT,FMT=6030) (NRFLS2(I,J),I=N1,N2)
WRITE (IOUT,FMT=6032) (IAVINTI1(I),I=1,NCOL)
WRITE (IOUT,FMT=6034) (IAVPRI1(I),I=1,NCOL)
WRITE (IOUT,FMT=6036) (IRMSDELI1(I),I=1,NCOL)
WRITE (IOUT,FMT=6038) (IABSDELI1(I),I=1,NCOL)
WRITE (IOUT,FMT=6040) (MEANDELI2(I,J),I=N1,N2)
WRITE (IOUT,FMT=6042) (RFACT(I,J),I=N1,N2)
WRITE (IOUT,FMT=6044) (IAVSIG1(I),I=1,NCOL)
WRITE (IOUT,FMT=6046) (IAVPRSIG1(I),I=1,NCOL)
WRITE (IOUT,FMT=6048) (IAVDELSIG1(I),I=1,NCOL)
C
C
IF (ONLINE) THEN
WRITE (ITOUT,FMT=6031) (I,I=N1,N2)
WRITE (ITOUT,FMT=6030) (NRFLS2(I,J),I=N1,N2)
WRITE (ITOUT,FMT=6032) (IAVINTI1(I),I=1,NCOL)
WRITE (ITOUT,FMT=6034) (IAVPRI1(I),I=1,NCOL)
WRITE (ITOUT,FMT=6036) (IRMSDELI1(I),I=1,NCOL)
WRITE (ITOUT,FMT=6038) (IABSDELI1(I),I=1,NCOL)
WRITE (ITOUT,FMT=6040) (MEANDELI2(I,J),I=N1,N2)
WRITE (ITOUT,FMT=6042) (RFACT(I,J),I=N1,N2)
WRITE (ITOUT,FMT=6044) (IAVSIG1(I),I=1,NCOL)
WRITE (ITOUT,FMT=6046) (IAVPRSIG1(I),I=1,NCOL)
WRITE (ITOUT,FMT=6048) (IAVDELSIG1(I),I=1,NCOL)
END IF
C
C
N1 = N1 + 10
C
C
IF (N1.LE.NBOXES) THEN
N2 = N2 + 10
N2 = MIN(N2,NBOXES)
NCOL = N2 - N1 + 1
GO TO 160
END IF
170 CONTINUE
C
C
END IF
C
C---- write out selected numbers to the socket
C
c IF(SOCKLO)THEN
c 6080 FORMAT('',
c $ 9('',
+ 'ok',
+ '')
6182 format('', i4, '',
+ 'Infinity',
+ '', f6.2, '',
+ '',
+ '', i5, '',
+ f6.2, '',
+ '', i5,
+ '', f6.2,
+ '',
+ '',
+ '', f6.2, '',
+ '', f6.2,
+ '',
+ '')
6082 format('', i4, '',
+ '', f6.2, '',
+ '', f6.2, '',
+ '',
+ '', i5, '',
+ f6.2, '',
+ '', i5,
+ '', f6.2,
+ '',
+ '',
+ '', f6.2, '',
+ '', f6.2,
+ ''
+ '')
6083 format('')
if(socklo) then
xmlline = ' '
write(xmlline, fmt=6081)
call write_socket_section(serverfd,
+ lenstr(xmlline), xmlline)
write(*, *) xmlline
xmlline = ' '
write(xmlline, fmt=6182) 1, dbin(1), nrespf(1),
+ fiovsdp(1), nrespp(1), piovsdp(1), fiovsds(1),
+ piovsds(1)
call write_socket_section(serverfd,
+ lenstr(xmlline), xmlline)
write(*, *) xmlline
do i = 2, 9
xmlline = ' '
write(xmlline, fmt=6082) i, dbin(i - 1), dbin(i),
+ nrespf(i), fiovsdp(i), nrespp(i), piovsdp(i),
+ fiovsds(i), piovsds(i)
call write_socket_section(serverfd,
+ lenstr(xmlline), xmlline)
write(*, *) xmlline
end do
xmlline = ' '
write(xmlline, fmt=6083)
call write_socket_length(serverfd,
+ lenstr(xmlline), xmlline)
write(*, *) xmlline
end if
end if
END
C
C
C
C ==========================
SUBROUTINE RFBMAT(BMAT,RCELL,WAVE)
C ==========================
IMPLICIT NONE
C
C
C
C---- calculate setting matrix from reciprocal unit cell; NOTE WELL; this
C is _NOT_ the same BMAT as derived from BMATRX.F (it _IS_ the same as
C Wolfgang's definition).
C
C RCELL - RECIPROCAL UNIT CELL PARAMETERS (GIVEN)
C IN RECIPROCAL ANGSTROEM AND DEGREES.
C
C WAVE - WAVELENGTH in Angstroems because MOSFLM wants AMAT in
C dimensionless units
C
C BMAT - SETTING MATRIX IN STANDARD ORIENTATION (RESULT)
C
C
C
C
C
INTEGER I
REAL RCELL(6),BMAT(3,3),RC(3),RS(3),ARG,DTOR,WAVE
DTOR = ATAN(1.0)/45.0
DO 10 I=1,3
ARG=RCELL(I+3)*DTOR
RC(I)=COS(ARG)
RS(I)=SIN(ARG)
10 ENDDO
BMAT(1,1)=RCELL(1)*RS(2)*WAVE
BMAT(1,2)=RCELL(2)*(RC(3)-RC(1)*RC(2))/RS(2)*WAVE
BMAT(1,3)=0.0
BMAT(2,1)=0.0
BMAT(2,2)=SQRT((RCELL(2)*WAVE*RS(1))**2-BMAT(1,2)**2)
BMAT(2,3)=0.0
BMAT(3,1)=RCELL(1)*RC(2)*WAVE
BMAT(3,2)=RCELL(2)*RC(1)*WAVE
BMAT(3,3)=RCELL(3)*WAVE
RETURN
END
C
C== RMAXR ==
SUBROUTINE RMAXR(LIMIT,THICK,IERR)
C =======================================
IMPLICIT NONE
C
C
C---- Determines the sizes of all the standard profiles using
C the maximum coordinate limits of each area (determined in
C PRSETUP) and the raster parameters. These are stored in ISIZE.
C Check against maximum allowed box dimensions and total number
C of pixels.
C
C LIMIT Limit for selection of refinement spots from central
C region of image used to form average spot profile.
C Spots lie within LIMIT (in 10 miocron units) of direct
C beam position (in X and Y)
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL THICK
INTEGER LIMIT,IERR
C ..
C .. Local Scalars ..
REAL A1,A2,CHGHT,CWIDTH,PKHGHT,PKWIDTH,VVAR,
+ XC,XTOFDPX,YC,XMID
INTEGER I,NC,NRX,NRY,NX,NXS,NY,NYS,
+ NXXSAVE,NYYSAVE,NXMIN,NYMIN,NXX,NYY,NFBOX,NXMBOX,NYMBOX,
+ ISTRIP,J,JSTART,NXRIM,NYRIM
LOGICAL SHRINK
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN
C ..
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MAX
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/modify.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file modify.h
C---- START of include file modify.h
C
C
C .. Arrays in common block /MODIFY/ ..
LOGICAL MODS
C ..
C .. Common Block /MODIFY/ ..
COMMON /MODIFY/MODS(30)
C ..
C
C
C&&*&& end_include ../inc/modify.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/trev.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file trev.h
C---- START of include file trev.h
C
C
C .. Scalars in Common block /TREV/ ..
INTEGER NXMAX,NYMAX
C ..
C .. Common Block /TREV/ ..
COMMON /TREV/NXMAX,NYMAX
C ..
C
C
C&&*&& end_include ../inc/trev.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
C ..
SAVE
C
C
SHRINK = .FALSE.
XMID = 0.75*LIMIT
XTOFDPX = DTOFD*FACT
VVAR = 0.5/ (XTOFDPX*XTOFDPX*XTOFRA*XTOFRA)
VARAS(1) = THICK/ (DTOFD*XTOFRA)
c IERR = 0
C
C---- Modified box expansion. Assume that the box size determined for
C the average spot profile for the central region of the image (which
C uses spots out to a distance LIMIT from direct beam position) is
C correct for spots at a distance 0.75*LIMIT, and then correct this to
C give the spot size at the centre of the image which is then expanded
C to allow for obliquity.
C Work out effective nxs at centre of film
C nxsp= (nxs-t*xf)/(1+xf**2/2*d**2)
C where xf is 0.75*LIMIT
C
C---- When optimimum raster parameters are determined by BESTMASK, it is
C possible to have a situation where the effective X-rim is
C determined by the corner cutoff rather than the actual X rim. Must
C allow for this possibility when calculating peak spot size
10 NXRIM = MAX(NRX,NC+1-NYS/2)
NYRIM = MAX(NRY,NC+1-NXS/2)
PKWIDTH = (NXS-MAX(2*NXRIM,0))
PKHGHT = (NYS-MAX(2*NYRIM,0))
C
C
A1 = FACT*THICK*XMID/ (DTOFD*XTOFRA)
A2 = XMID*XMID/ (2*DTOFD*DTOFD) + 1.0
CWIDTH = (PKWIDTH-A1)/A2
CHGHT = (PKHGHT-A1)/A2
VARAS(4) = PKWIDTH - CWIDTH
VARAS(5) = PKHGHT - CHGHT
IF (DEBUG(14)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6002)
WRITE (IOUT,FMT=6002)
IF (ONLINE) WRITE (ITOUT,FMT=6000) PKWIDTH,PKHGHT,CWIDTH,CHGHT
WRITE (IOUT,FMT=6000) PKWIDTH,PKHGHT,CWIDTH,CHGHT
END IF
C
C
VARAS(2) = CWIDTH*VVAR
VARAS(3) = CHGHT*VVAR
C
C
C
NXMAX = 0
NYMAX = 0
C
C---- Set up the maximum size of measurement box required for each
C standard profile, using raster expansion and the maximum coordinate
C (in X and Y) for each box.
C
NXMIN = 999
NYMIN = 999
DO 12 I = 1,NUMBOX
C
C---- Skip if this is not a valid box
C
IF (.NOT.BOX(I)) GOTO 12
XC = XPMAX(I)*FACT
YC = YPMAX(I)*FACT
NX = (VARAS(2)*XC+VARAS(1))*XC - VARAS(4) + 0.5
NY = (VARAS(3)*YC+VARAS(1))*YC - VARAS(5) + 0.5
C
NX = ((NX+1)/2)*2 + NXS
NY = ((NY+1)/2)*2 + NYS
ISIZE(I,1) = NX
ISIZE(I,2) = NY
C
C---- Find the smallest box
C
IF (NX.LT.NXMIN) THEN
NXMIN = NX
NXMBOX = I
END IF
IF (NY.LT.NYMIN) THEN
NYMIN = NY
NYMBOX = I
END IF
IF (DEBUG(14)) THEN
IF (ONLINE) WRITE(ITOUT,FMT=6004) I,XC,YC,NX,NY
WRITE(IOUT,FMT=6004) I,XC,YC,NX,NY
6004 FORMAT(1X,I10,2F10.0,2I5)
END IF
12 CONTINUE
C
C---- Now check that there is no expansion greater than 2 pixels from one
C strip to the next. Start at strip with smallest box and work to RHS
C
MAXR = 0
CALL GETSTRIP(NXMBOX,ISTRIP)
NXX = NXMIN
DO 20 I = ISTRIP+1,NXLINE-1
C
C---- Find the first valid box in thIs column
C
NFBOX = NPFIRST(I)
DO 22 J = 1,NYLINE-1
IF (BOX(NFBOX)) THEN
JSTART = J
GOTO 24
END IF
NFBOX = NFBOX + 1
22 CONTINUE
C
C---- No valid box in this column
C
GOTO 20
C
C---- Test its X dimension against that of previous column
C
24 NXXSAVE = ISIZE(NFBOX,1)
C
IF (ISIZE(NFBOX,1)-NXX.GT.2) THEN
C
C---- Size is too large, reset X dimension of all valid boxes in this
C row
C
NXXSAVE = NXX + 2
DO 30 J = JSTART,NYLINE-1
IF (.NOT.BOX(NFBOX)) GOTO 28
ISIZE(NFBOX,1) = NXX + 2
28 NFBOX = NFBOX + 1
30 CONTINUE
END IF
NXX = NXXSAVE
20 CONTINUE
C
C---- Now from smallest box strip back to start of image
C
NXX = NXMIN
DO 40 I = ISTRIP-1,1,-1
C
C---- Find the first valid box in thIs column
C
NFBOX = NPFIRST(I)
DO 42 J = 1,NYLINE-1
IF (BOX(NFBOX)) THEN
JSTART = J
GOTO 44
END IF
NFBOX = NFBOX + 1
42 CONTINUE
C
C---- No valid box in this column
C
GOTO 40
C
C---- Test its X dimension against that of previous column
C
44 NXXSAVE = ISIZE(NFBOX,1)
C
IF (ISIZE(NFBOX,1)-NXX.GT.2) THEN
C
C---- Size is too large, reset X dimension of all valid boxes in this
C column
C
NXXSAVE = NXX + 2
DO 50 J = JSTART,NYLINE-1
IF (.NOT.BOX(NFBOX)) GOTO 48
ISIZE(NFBOX,1) = NXX + 2
48 NFBOX = NFBOX + 1
50 CONTINUE
END IF
NXX = NXXSAVE
40 CONTINUE
C
C---- Now in Y direction, start with row of smallest box and work up
C
CALL GETYIND(NYMBOX,NY)
NYY = NYMIN
DO 60 I = NY+1,NYLINE-1
NFBOX = I
C
C---- Find the first valid box in thIs row
C
DO 62 J = 1,NXLINE-1
IF (BOX(NFBOX)) THEN
JSTART = J
GOTO 64
END IF
NFBOX = NFBOX + NYLINE - 1
62 CONTINUE
C
C---- No valid box in this row
C
GOTO 60
C
C---- Test its Y dimension against that of previous row
C
64 NYYSAVE = ISIZE(NFBOX,2)
IF (ISIZE(NFBOX,2)-NYY.GT.2) THEN
C
C---- Size is too large, reset Y dimension of all valid boxes in this
C row
C
NYYSAVE = NYY + 2
C
C---- Loop over all boxes in this row setting the Y dimension
C
DO 70 J = JSTART,NXLINE-1
IF (.NOT.BOX(NFBOX)) GOTO 68
ISIZE(NFBOX,2) = NYY + 2
68 NFBOX = NFBOX + NYLINE -1
70 CONTINUE
END IF
NYY = NYYSAVE
60 CONTINUE
C
C---- Now going down the row
C
NYY = NYMIN
DO 80 I = NY-1,1,-1
NFBOX = I
C
C---- Find the first valid box in thIs row
C
DO 82 J = 1,NXLINE-1
IF (BOX(NFBOX)) THEN
JSTART = J
GOTO 84
END IF
NFBOX = NFBOX + NYLINE - 1
82 CONTINUE
C
C---- No valid box in this row
C
GOTO 80
C
C---- Test its Y dimension against that of previous row
C
84 NYYSAVE = ISIZE(NFBOX,2)
IF (ISIZE(NFBOX,2)-NYY.GT.2) THEN
C
C---- Size is too large, reset Y dimension of all valid boxes in this
C row
C
NYYSAVE = NYY + 2
C
C---- Loop over all boxes in this row setting the Y dimension
C
DO 90 J = JSTART,NXLINE-1
IF (.NOT.BOX(NFBOX)) GOTO 88
ISIZE(NFBOX,2) = NYY + 2
88 NFBOX = NFBOX + NYLINE -1
90 CONTINUE
END IF
NYY = NYYSAVE
80 CONTINUE
C
C---- Find maximum box after this check
C
DO 92 I = 1,NUMBOX
IF (.NOT.BOX(I)) GOTO 92
NX = ISIZE(I,1)
NY = ISIZE(I,2)
NXMAX = MAX(NXMAX,NX)
NYMAX = MAX(NYMAX,NY)
MAXR = MAX(MAXR,NX*NY)
92 CONTINUE
C
IF (DEBUG(14)) THEN
WRITE(IOUT,FMT=6014)
IF (ONLINE) WRITE(ITOUT,FMT=6014)
6014 FORMAT(/1X,'Final box sizes')
DO 100 I = 1,NUMBOX
IF (ONLINE) WRITE(ITOUT,FMT=6012) I,BOX(I),ISIZE(I,1),
+ ISIZE(I,2)
WRITE(IOUT,FMT=6012) I,BOX(I),ISIZE(I,1),ISIZE(I,2)
100 CONTINUE
6012 FORMAT(1X,'Box',I3,' Valid ',L1,' Modified Size',2I4)
END IF
IF (MAXR.GT.MAXBOX) THEN
C
C---- If possible, reduce overall size of box and try again
C
IF ((NRY.GT.1).OR.(NRX.GT.1)) THEN
SHRINK = .TRUE.
IERR = 1
IF (NRX.GT.1) THEN
IRAS(1) = IRAS(1) - 2
NRX = NRX - 1
END IF
IF (NRY.GT.1) THEN
IRAS(2) = IRAS(2) - 2
NRY = NRY - 1
END IF
MAXR = NXS*NYS
GOTO 10
ELSE
IF (FIXBOX) THEN
WRITE (IOUT,FMT=6016) MAXR,MAXBOX
IF (ONLINE) WRITE (ITOUT,FMT=6016) MAXR,MAXBOX
ELSE
WRITE (IOUT,FMT=6008) MAXR,MAXBOX
IF (ONLINE) WRITE (ITOUT,FMT=6008) MAXR,MAXBOX
END IF
IERR = 2
END IF
C
ELSE IF (NXMAX.GT.MAXDIM .OR. NYMAX.GT.MAXDIM) THEN
C
C---- If possible, reduce overall size of box and try again
C
IF ((NRY.GT.1).OR.(NRX.GT.1)) THEN
SHRINK = .TRUE.
IERR = 1
IF ((NXMAX.GT.MAXDIM).AND.(NRX.GT.1)) THEN
IRAS(1) = IRAS(1) - 2
NRX = NRX - 1
END IF
IF ((NYMAX.GT.MAXDIM).AND.(NRY.GT.1)) THEN
IRAS(2) = IRAS(2) - 2
NRY = NRY - 1
END IF
MAXR = NXS*NYS
GOTO 10
ELSE
NWRN = NWRN + 1
WRITE (IOUT,FMT=6010) MAXDIM,NXMAX,NYMAX
IF (ONLINE) WRITE (ITOUT,FMT=6010) MAXDIM,NXMAX,NYMAX
IERR = 2
END IF
END IF
C
C---- Print warning if shrunk
C
IF (SHRINK) THEN
WRITE(IOUT,FMT=6020) IRAS(1),IRAS(2),MAXBOX
IF (ONLINE) WRITE(ITOUT,FMT=6020) IRAS(1),IRAS(2),MAXBOX
END IF
6020 FORMAT(//,1X,'***** WARNING *****',/,1X,'Overall dimensions',
+ ' of measurement box reduced to',2I3,' to avoid box',
+ ' becoming',/,1X,
+ 'too large (maximum number of pixels is',I5,')',/,1X,
+ 'If this makes the number of background pixels ',
+ 'unacceptably small, change the parameter',/,1X,
+ 'MAXBOX with a global edit and recompile the program.')
C
C---- Format statements
C
6000 FORMAT (/1X,'Peak size of ',F5.1,' by',F5.1,' becomes',F5.1,' by'
+ ,F5.1,' at centre of image',//,1X,' Box number ',
+ ' XMAX YMAX NX NY')
6002 FORMAT (/1X,'**** DEBUG OUTPUT FROM RMAXR ****')
6008 FORMAT (1X,'Expanded measurement box is',I8,' pixels which is',
+ ' bigger than maximum allowed (',I4,')',/,1X,
+ 'Either reduce the overall size of measurement box',
+ ' (keyword RASTER) or change the',/,1X,
+ ' ratio of the number of background pixels',/,1X,
+ 'to the number of peak pixels (keywords',
+ ' PROFILE RATIO x, default value is 2)',/,1X,'used in ',
+ 'the optimisation of the overall size of the ',
+ 'measurement box',/,1X,'or decrease the effective',
+ 'spot size by increasing the tolerance',/,1X,
+ '(Keywords PROFILE TOLERANCE x) or change',
+ ' parameter MAXBOX and recompile program')
6010 FORMAT (' EXPANDED BOX DIMENSION LARGER THAN',I4,' PIXELS ',
+ /,1X,'Actual size is',I4,' in X and ',I4,' in Y',/,1X,
+ 'Reduce the box dimensions or change parameter MAXDIM',
+ ' and recompile program',/,1X,
+ 'NYMAX=',2I6)
6016 FORMAT (1X,'Expanded measurement box is',I8,' pixels which is',
+ ' bigger than maximum allowed (',I4,')',/,1X,
+ 'Reduce the overall size of measurement box',
+ ' (keyword RASTER) or change',/,1X,
+ ' parameter MAXBOX and recompile program')
C
C
END
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== ROTATE ==
SUBROUTINE ROTATE
C =================
C
IMPLICIT NONE
C
C---- For strategy option
C writes an mtz file containing all generated reflections for the
C rotation range specified, after reducing the reflection indices
C to the reciprocal space asymmetric unit.
C column headings will be
C "H,K,L,BATCH,PHI,IC"
C
C
C "BATCH" is 9999 for generated data (-999 for unique reflections)
C
C "PHI" is the starting phi angle of the rotation range segment in
C which a reflection is generated.
C
C "IC" is modulo 2 of the number of the symmetry operation used
C to generate the correct indices, plus 1. Friedel pairs will
C therefore have values of 1 and 2. This is used to calculate the
C number of Friedel pairs.
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
C
C
C---- Set DIVH=DIVV=ETA=.000001 to avoid generating partials at start
C and end of each subblock of data.
C
C ..
C .. Local Scalars ..
REAL PHIINCX,PHISTX,DTOR,DELR,THETA,RPLUS,THPLUS,T,
+ SX,CX,SY,CY,PHI1,PHI2,PHIX,PHIST1,PHIFN1,PHIFIX
INTEGER I,IPACK,ISEG,J,NNPACK,NUMB,PHEAD,NTOT,NSTART,
+ IRUN,IMAT,IUMAT,ICELL,ICHECK,MODERK,JAXIS,IUNIQ
CHARACTER LINE*80,ABCSTR(3)*1
LOGICAL NULINE,HIGHSYM
C ..
C .. Local Arrays ..
REAL SPHIFIN(NSEGMAX),SPHIINC(NSEGMAX),SPHIST(NSEGMAX),
+ PHIBEGIN(MAXPAX),PHIFINISH(MAXPAX)
REAL ADATA(MCOLSTR)
INTEGER NSEGPACK(MAXPAX),NUMBPACK(MAXPAX),ISFIRST(NSEGMAX)
INTEGER*2 IORDER(NSEGMAX),IPHI(NSEGMAX)
INTEGER*2 IHKLSTR(MCOLSTR,NREFSTR)
C ..
C .. External Subroutines ..
EXTERNAL LWCLOS,HEADERMTZ,REEK,SORTUP2,ALIGN,LAUEPHI,SETMAT,
+ WINDIO
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
EQUIVALENCE (IHKLSTR(1,1),IMAGE(1))
SAVE
C ..
C .. Data ..
DATA ABCSTR/'a','b','c'/
C ..
NULINE = .TRUE.
OFFPHI = .FALSE.
IF (DEBUG(54)) THEN
WRITE(IOUT,FMT=6020) AUTO,NSEGM,ISTRUN,NSTRUN
IF (ONLINE) WRITE(ITOUT,FMT=6020) AUTO,NSEGM,ISTRUN,NSTRUN
END IF
6020 FORMAT(//1X,'Entering ROTATE, AUTO',L2,' NSEGM',I4,' ISTRUN',I3,
+ ' NSTRUN',I3)
C
C---- Determine crystal orientation wrt lab axes X,Y,Z
C
CALL ALIGN(JAXIS,IUNIQ)
C
C---- Determine phi rotation required for this laue group
C and crystal orientation
C
CALL LAUEPHI(NLAUE,IROTAX,PHILAUE,PHIPAD)
C
C---- Now set up the start angle and rotation range for AUTO mode if
C this has not been defined by the user
C
IF (AUTO.AND.((PHIFIN(NSEGM)-PHIST(NSEGM)).EQ.0)) THEN
PHIX = PHIZONE
C
C---- If PHIPAD zero, pad out by the angle between axis and rotation axis
C (set in ALIGN)
C ***** Change this, does not always pad out enough. Pad out by greater
C of this angle and 60 degrees if lauephi is < 90, otherwise
C pad by this angle. Note half pad value applied at start,
C half at end of oscillation range.
C
IF (PHIPAD.EQ.0) THEN
IF (PHILAUE.LT.90.0) THEN
PHIFIX = MAX(60.0,PHIROTAX)
ELSE
PHIFIX = PHIROTAX
END IF
PHIX = PHIX - 0.5*PHIFIX
OFFPHI = .TRUE.
END IF
IF (PHIX.LT.0) THEN
PHIX = PHIX + 360.0
PHIADD(NSEGM) = 360.0
END IF
CAL IF (PHIX.LT.0) PHIX = PHIX + 360.0
CAL IF (PHIX.GT.360) PHIX = PHIX - 360.0
PHIST(NSEGM) = PHIX + ISTRUN*360
PHIFIN(NSEGM) = PHIST(NSEGM) + PHILAUE + PHIPAD
IF (PHIPAD.EQ.0) PHIFIN(NSEGM) = PHIFIN(NSEGM) + PHIFIX
END IF
C
C
HIGHSYM = (NLAUE.GT.6)
IF (AUTO) THEN
IF (HIGHSYM) THEN
IF (OFFPHI) THEN
WRITE(IOUT,FMT=6022) ABCSTR(IUNIQ), 0.5*PHIFIX,PHIZONE
IF (ONLINE) WRITE(ITOUT,FMT=6022) ABCSTR(IUNIQ),
+ 0.5*PHIFIX,PHIZONE
ELSE
WRITE(IOUT,FMT=6024) ABCSTR(IUNIQ), PHIZONE
IF (ONLINE) WRITE(ITOUT,FMT=6024) ABCSTR(IUNIQ), PHIZONE
END IF
ELSE
IF (OFFPHI) THEN
WRITE(IOUT,FMT=6026) ABCSTR(JAXIS), 0.5*PHIFIX,PHIZONE
IF (ONLINE) WRITE(ITOUT,FMT=6026) ABCSTR(JAXIS),
+ 0.5*PHIFIX,PHIZONE
ELSE
WRITE(IOUT,FMT=6028) ABCSTR(JAXIS), PHIZONE
IF (ONLINE) WRITE(ITOUT,FMT=6028) ABCSTR(JAXIS), PHIZONE
END IF
END IF
END IF
6022 FORMAT(/,1X,'Start strategy search with ',A,' axis offset by',
+ F6.1,' degrees from YZ plane at phi',F7.2)
6024 FORMAT(/,1X,'Start strategy search with ',A,' axis in YZ plane',
+ ' at phi',F7.2)
6026 FORMAT(/,1X,'Start strategy search with ',A,' axis offset by',
+ F6.1,' degrees from XZ plane at phi',F7.2)
6028 FORMAT(/,1X,'Start strategy search with ',A,' axis in XZ plane',
+ ' at phi',F7.2)
C
IF (DEBUG(54)) THEN
WRITE(IOUT,FMT=6030) NLAUE,IROTAX,PHILAUE,PHIPAD,PHIST(NSEGM),
+ PHIFIN(NSEGM),PHIADD(NSEGM)
IF (ONLINE) WRITE(ITOUT,FMT=6030) NLAUE,IROTAX,PHILAUE,PHIPAD,
+ PHIST(NSEGM),PHIFIN(NSEGM),PHIADD(NSEGM)
END IF
6030 FORMAT(1X,'NLAUE',I4,' IROTAX',I3,' PHILAUE',F8.2,' PHIPAD',F8.2,
+ /,1X,'PHIstart',F6.1,' PHIend',F6.1,' PHIadd',F6.1)
C
DTOR = ATAN(1.0)*4.0/180.0
SCNSZ = 40.0*RAST
FACT = 0.4/SCNSZ
DELAMB = 0.0
DELCOR = 0.0
C
DIVH = 0.0
DIVV = DIVH
C
C---- Do not set ETA to zero as this gives a zero value for RSPOT which can
C give divide by zero errors in DSTAR
C
ETA = 0.00000001
C
C---- First sort the different segments into order of increasing PHI,
C necessary for "complete" algorithm to work
C transfer phi angles to IPHI, integer*2 for sort
C
IF (NSEGM.NE.1) THEN
C
C
DO 10 I = 1,NSEGM
IPHI(I) = NINT ( PHIST(I) )
10 CONTINUE
C
C ************************
CALL SORTUP2(NSEGM,IPHI,IORDER)
C ************************
C
DO 20 I = 1,NSEGM
J = IORDER(I)
SPHIST(I) = PHIST(J)
SPHIFIN(I) = PHIFIN(J)
SPHIINC(I) = PHIINC(J)
ISFIRST(I) = IFIRSTONE(J)
20 CONTINUE
C
C
DO 30 I = 1,NSEGM
PHIST(I) = SPHIST(I)
PHIFIN(I) = SPHIFIN(I)
PHIINC(I) = SPHIINC(I)
IFIRSTONE(I) = ISFIRST(J)
30 CONTINUE
C
C
WRITE (IOUT,FMT=6000) (NSEGM-NLAST+1)
IF (ONLINE) WRITE (ITOUT,FMT=6000) (NSEGM-NLAST+1)
END IF
6000 FORMAT (//1X,'The',I3,' input segments for this run have been',
+ ' sorted into order of increasing phi')
C
C---- Work out total number of packs for all segments, and set up
C NSEGPACK which gives segment number for any pack, while
C NUMBPACK gives the sequential number within this segment
C
DO 50 I = NLAST,NSEGM
NNPACK = NINT((PHIFIN(I)-PHIST(I))/PHIINC(I))
IF (PHIFIN(I).GT.(PHIST(I)+NNPACK*PHIINC(I)))
+ NNPACK = NNPACK + 1
NNPACK = NNPACK + NNPACKS
C
C
DO 40 J = NNPACKS + 1,NNPACK
NUMBPACK(J) = J - NNPACKS
NSEGPACK(J) = I
40 CONTINUE
C
C
NNPACKS = NNPACK
50 CONTINUE
C
C
PHIBEGIN(1) = PHIST(1)
PHIFINISH(1) = PHIST(1) + PHIINC(1)
C
C
IF (NNPACKS.EQ.1) GOTO 62
C
DO 60 I = NLASTPACK,NNPACKS
ISEG = NSEGPACK(I)
NUMB = NUMBPACK(I)
PHISTX = PHIST(ISEG)
PHIINCX = PHIINC(ISEG)
PHIBEGIN(I) = REAL((NUMB - 1))*PHIINCX + PHISTX
PHIFINISH(I) = PHIBEGIN(I) + PHIINCX
C
C---- Ensure last pack does not go beyond final phi
C
IF (PHIFINISH(I).GT.PHIFIN(ISEG)) PHIFINISH(I) = PHIFIN(ISEG)
60 CONTINUE
C
C
C
C---- Generate reflections, and store in memory in subroutine WMTZSP
C called by REEKE
C
C---- If the calculation is to be speeded up by using a reduced cell,
C do that now, but not if it has already been done !
C
IF ((CELLSCAL.NE.1.0).AND.(.NOT.SHRUNK)) THEN
SHRUNK = .TRUE.
DO 61 I = 1,3
CELL(I) = CELL(I)/CELLSCAL
61 CONTINUE
IMAT = 1
IUMAT = 0
ICELL = 1
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
END IF
C
C---- Calculate the reciprocal sphere radius DSTPL - corresponding to
C a slightly higher resolution to be used in checking overlaps
C on the outside of the picture
C
62 DELR = MAX(MINDTX,MINDTY)*2.0
THETA = ASIN(DSTMAX/2.0)
T = TAN(2.0*THETA)
C
C
C
IF (VEE) THEN
C
C---- Vee cassette
C
RPLUS = 2.0*XTOFD*T/ (SQRT(3.0)+T) + DELR
THPLUS = ATAN(SQRT(3.0)/ (2.0*XTOFD/RPLUS-1.0))*0.5
ELSE
C
C---- Flat cassette
C
RPLUS = XTOFD*T + DELR
THPLUS = ATAN(RPLUS/XTOFD)*0.5
END IF
C
C
DSTPL = SIN(THPLUS)*2.0
DSTPL2 = DSTPL*DSTPL
C
C---- Initialise RMC matrix - for the X and Y missetting angles.
C Rotation about x and then y
C RMC = PHIY . PHIX
C
SX = SIN(DELPHI(1)*DTOR)
SY = SIN(DELPHI(2)*DTOR)
CX = COS(DELPHI(1)*DTOR)
CY = COS(DELPHI(2)*DTOR)
C
RMC(1,1) = CY
RMC(1,2) = SX*SY
RMC(1,3) = CX*SY
RMC(2,1) = 0.0
RMC(2,2) = CX
RMC(2,3) = -SX
RMC(3,1) = -SY
RMC(3,2) = SX*CY
RMC(3,3) = CX*CY
C
IF (WINOPEN) THEN
WRITE(IOLINE,FMT=6050)
6050 FORMAT(/,/,'Generating reflection list')
CALL WINDIO(NULINE)
END IF
C
DO 70 IPACK = NLASTPACK,NNPACKS
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Pass pack number through common as IPCKCUR
C
IPCKCUR = IPACK + IFIRSTONE(NSEGPACK(IPACK))
PHIBEG = PHIBEGIN(IPACK)
PHIEND = PHIFINISH(IPACK)
MODERK = 0
C *****
CALL REEK(IHKLSTR,MODERK)
C *****
C
IRUN = NINT(PHIBEG)/360 + 1
PHI1 = PHIBEG - (IRUN-1)*360
PHI2 = PHIEND - (IRUN-1)*360
IF (PHI1.GT.180) THEN
PHI1 = PHI1 - 360.0
PHI2 = PHI2 - 360.0
END IF
IF (IPACK.EQ.NLASTPACK) THEN
WRITE(IOUT,FMT=6001) IRUN,PHIINCX
IF (ONLINE) WRITE(ITOUT,FMT=6001) IRUN,PHIINCX
6001 FORMAT(1X,'Generating the reflections for run',I3,/,1X,
+ 'For practical reasons the reflections will be generated in',
+ ' segments of',F5.1,' degrees (STEP keyword)')
END IF
WRITE (IOUT,FMT=6002) PHI1,PHI2,NSTRAT
IF (ONLINE) WRITE (ITOUT,FMT=6002) PHI1,PHI2,NSTRAT
6002 FORMAT (1X,'Rotation range',F7.1,' to ',F7.1,
+ ' Total number of reflections',I8)
IF (IPACK.EQ.NLASTPACK) PHIST1 = PHI1
IF (IPACK.EQ.NNPACKS) PHIFN1 = PHI2
70 CONTINUE
C
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6052) PHIST1,PHIFN1
6052 FORMAT('Generated reflections for phi range',F7.1,' to',F7.1)
CALL MXDWIO(LINE,1)
LINE = ' '
WRITE(LINE,FMT=6054)
6054 FORMAT('Sorting the generated list.')
CALL MXDWIO(LINE,1)
END IF
C
NLASTPACK = NNPACKS+1
NLAST = NSEGM + 1
C
C---- Return to generate other runs if required
C
IF (ISTRUN+1.LT.NSTRUN) RETURN
C
C---- Now sort1 reflections
C
IF (ONLINE) WRITE(ITOUT,FMT=6040)
6040 FORMAT(/,1X,'Sorting the generated reflection list.')
C
C ***************************
CALL REFSOR(IHKLSTR,NSTRAT,MCOLSTR,MCOLSTR*NSTRAT)
C ***************************
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
IF (DEBUG(54)) THEN
DO 80 I = 1,NDEBUG(54)
WRITE(IOUT,FMT=6010) (IHKLSTR(J,I),J=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6010) (IHKLSTR(J,I),J=1,3)
6010 FORMAT(1X,'Gen indices',3I5)
80 CONTINUE
END IF
C
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6056)
6056 FORMAT('Generating the list of unique reflections.')
CALL MXDWIO(LINE,1)
END IF
CALL UNIQUE(IHKLSTR)
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Now sort the unique reflections
C
IF (ONLINE) WRITE(ITOUT,FMT=6042)
6042 FORMAT(/,1X,'Sorting the unique reflection list.')
C
C ***************************
CALL REFSOR(IHKLSTR(1,NSTRAT+1),NUNIQ,MCOLSTR,MCOLSTR*NUNIQ)
C ***************************
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Now merge the unique and generated reflections (and write
C sorted list to MTZ file
C
NTOT = NSTRAT + NUNIQ
NSTART = (NTOT/2)*2 + 3
IF (ONLINE) WRITE(ITOUT,FMT=6044)
6044 FORMAT(/,1X,'Merging the generated and unique reflection list.')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6058)
6058 FORMAT('Merging the generated and unique reflection list.')
CALL MXDWIO(LINE,3)
END IF
C
CALL MERGHKL(IHKLSTR,NSTRAT,NUNIQ,NTOT,IHKLSTR(1,NSTART))
C
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Now call complete
C
CALL COMPLETE(IHKLSTR,NTOT,IHKLSTR(1,NSTART))
C
C
C---- Format statements
C
6006 FORMAT (//2X,'**** ERROR, SYMMETRY NOT SUPPLIED ***')
C
C
END
C== ROTMAT ==
SUBROUTINE ROTMAT(DELPHI,R,IMODE)
C ===========================
C
C---- Forms rotation matrix R from the three angles in DELPHI
C (angles in degrees (IMODE .eq.1) or radians (IMODE .ne. 1), corresponding
C to
C
C [R] = [phiz] . [phiy] . [phix]
C
C
C | cz -sz 0 | | cy 0 sy | | 1 0 0 |
C [R] = | sz cz 0 | . | 0 1 0 | . | 0 cx -sx |
C | 0 0 1 | |-sy 0 cy | | 0 sx cx |
C
C ..
C .. Array Arguments ..
REAL DELPHI(3),R(3,3)
C ..
C .. Scalar Arguments ..
INTEGER IMODE
C ..
C .. Local Scalars ..
INTEGER I
REAl DTOR
C ..
C .. Local Arrays ..
REAL C(3),S(3)
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,SIN
C ..
C
DTOR = 4.0*ATAN(1.0)/180.0
C
DO 10 I = 1,3
IF(IMODE.EQ.1)THEN
C(I) = COS(DELPHI(I)*DTOR)
S(I) = SIN(DELPHI(I)*DTOR)
ELSE
C(I) = COS(DELPHI(I))
S(I) = SIN(DELPHI(I))
ENDIF
10 CONTINUE
C
C
R(1,1) = C(2)*C(3)
R(1,2) = -C(1)*S(3) + S(1)*S(2)*C(3)
R(1,3) = C(1)*S(2)*C(3) + S(1)*S(3)
R(2,1) = C(2)*S(3)
R(2,2) = S(1)*S(2)*S(3) + C(1)*C(3)
R(2,3) = -S(1)*C(3) + C(1)*S(2)*S(3)
R(3,1) = -S(2)
R(3,2) = S(1)*C(2)
R(3,3) = C(1)*C(2)
C
C
END
SUBROUTINE ROTMAT2(DETNOR,TILT,TWIST)
IMPLICIT NONE
C
C---- Forms normal vector DETNOR from two angles TILT and TWIST
C (angles in RADIANs); code originally from ROTMAT.F, which has
C
C [R] = [TWIST] . [TILT] . [Detector NORM]
C
C
C | 1 0 0 | | c(twist) 0 s(twist)| | 0 |
C [R] = | 0 c(tilt) s(tilt)| . | 0 1 0 | . | 0 |
C | 0 -s(tilt) c(tilt)| |-s(twist) 0 c(twist)| | 1 |
C
C ..
C .. Array Arguments ..
REAL DETNOR(3)
C ..
C .. Scalar Arguments
REAL TILT,TWIST
C ..
C .. Local Scalars ..
INTEGER I
REAL DTOR
C ..
C .. Local scalars ..
REAL C1,C2,S1,S2
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,SIN
C ..
C
DTOR = 4.0*ATAN(1.0)/180.0
C
C1 = COS(-TWIST*DTOR)
C2 = COS(-TILT*DTOR)
S1 = SIN(-TWIST*DTOR)
S2 = SIN(-TILT*DTOR)
C
C
DETNOR(1) = S2
DETNOR(2) = S1*C2
DETNOR(3) = C1*C2
C
END
!------------------------------------------------------------------------------
! ROTMATY_FROM_ANGLE: generate a rotation matrix about Y given an angle
!
! This code was cribbed unashamedly from Ingo Steller's code from
! DPS_INDEX
!______________________________________________________________________________
SUBROUTINE ROTMATY_FROM_ANGLE(ANGLE,MATRIX)
REAL ANGLE,MATRIX(3,3)
real dtor
DTOR = ATAN(1.0)*4.0/180.0
MATRIX(1,1) = COS(DTOR*ANGLE)
MATRIX(1,2) = 0.0
MATRIX(1,3) = -SIN(DTOR*ANGLE)
MATRIX(2,1) = 0.0
MATRIX(2,2) = 1.0
MATRIX(2,3) = 0.0
MATRIX(3,1) = SIN(DTOR*ANGLE)
MATRIX(3,2) = 0.0
MATRIX(3,3) = COS(DTOR*ANGLE)
RETURN
END
!==============================================================================
C
C
C
SUBROUTINE RSTSPD (YB, XB)
C ==========================
C
C Reset spatial distortion parameters,
C for new main beam position YB, XB
C Ip scanner version
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
REAL YB, XB
C
C&&*&& include ../inc/dsdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsdinc.h
C---- START of include file dsdinc.h
C
C/DSDINC/
C
C Detector image file parameters
c
C imgdrc The string defines the axis order for display in terms
C of x (across) and y (up). The slower moving axis is
C given first followed by the faster moving axis. Minus
C signs are used when the order of an axis is reversed.
C
C examples: FAST +x+y slow axis (Zms) across, fast axis (Yms) up
C Mar -x+y Zms across backwards, fast axis (Yms) up
C
character*8 drcdef
parameter (drcdef='-x+y')
character*8 imgdrc
common /imgstc/ imgdrc
save /imgstc/
C/DSDINC/
C&&*&& end_include ../inc/dsdinc.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C
C IYLEN maximum usable pixel along Yms
C NREC maximum usable pixel along Zms
C YBEAM Y coordinate of mainbeam
C XBEAM X coordinate of mainbeam
C YPXSIZ pixel size in mm along Yms
C ZPXSIZ pixel size in mm along Zms
C ROFF radial offset
C TOFF tangential offset
C YCENS centre of scan on Yms
C ZCENS centre of scan on Zms
C XFRBEM ) mainbeam position relative to centre of scan, in mm
C YFRBEM )
C
C
REAL XBEAM,YBEAM,XFRBEM,YFRBEM,ZCENS,YCENS
YBEAM = YB
XBEAM = XB
YCENS = IYLEN/2.0
ZCENS = NREC/2.0
C
C Derive main position in mm relative to scan centre
C Note that the main beam position may or not need to be corrected for
C distortion, depending on how it is derived. If it comes from direct,
C observation of the beam, it should be, if from measurements (eg of
C powder ring) in the mm frame, it should not be. Here it is NOT corrected
XFRBEM = (XBEAM - ZCENS) * RAST
YFRBEM = (YBEAM - YCENS) * RAST/YSCAL
C
RETURN
C
END
C== RSYMM ==
SUBROUTINE RSYMM(PROFILE)
C =========================
C
IMPLICIT NONE
C
C---- Do R-sym analysis on image by image basis
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
LOGICAL PROFILE
C ..
C .. Local Scalars ..
C REAL
INTEGER I,J,K,NSORT
LOGICAL MSRD
C ..
C .. Local Arrays ..
INTEGER*2 IKEYS(5,NREFLS)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL REFSOR
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
SAVE
C ..
C .. Data statements ..
NSORT = 0
C
C---- Loop over reflections, writing out measured intensities
C
DO 10 I = 1,TOSPT
C
C---- Check if this reflection was measured, flag is set in PROCESS,
C and in WRMTZ badspots due to poor profile fit (PKRATIO) are
C flagged with IGFLAG = -1 so they can be identified as badspots
C and displayed
C
C** CHANGED this, IGFLAG now carries badspoot flag as -ve number.
C
C** MSRD = ((IGFLAG(I).GT.0).OR.(IGFLAG(I).EQ.-1))
MSRD = (IGFLAG(I).GT.0)
IF (.NOT.MSRD) GOTO 10
C
C---- Check this is fully recorded. Note that MISYMG = MP*256+KSYM and
C added partials have MP=0, so test for fully recorded is MISYMG<255
C
IF (MISYMG(I).GT.255) GOTO 10
C
C----- Test for more than 65535 reflections (can't store more than this
C without making KEYS INTEGER*4
C
IF (NSORT.EQ.65535) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
6000 FORMAT(/1X,'*** FATAL ERROR ***',/,1X,'Cannot store more',
+ ' than 65535 fully recorded reflections',/,1X,'for Rsym',
+ ' analysis',/,1X,'Array KEYS must be changed to INTEGER*4',
+ /,1X,'Consult Andrew Leslie')
STOP
END IF
NSORT = NSORT + 1
IKEYS(1,NSORT) = IHG(I)
IKEYS(2,NSORT) = IKG(I)
IKEYS(3,NSORT) = ILG(I)
IKEYS(4,NSORT) = MISYMG(I)
IKEYS(5,NSORT) = I
10 CONTINUE
C
IF (NSORT.EQ.0) GOTO 50
C
C---- Sort the reflections
C
C
C ***************************
CALL REFSOR(IKEYS,NSORT,5,5*NSORT)
C ***************************
50 CALL RSYMM2(IKEYS,NSORT,PROFILE)
END
C== RSYMM2 ==
SUBROUTINE RSYMM2(IKEYS,NSORT,PROFILE)
C =======================================
C
C
IMPLICIT NONE
C This routine analyses the agreement between symmetry related
C fully recorded reflections from a single image.
C Maximum number of symmetry equivalents is currently 20.
C
C
C On entry:
C IKEYS array containing sort keys and sorted pointers
C to data arrays for NSORT valid fully-recorded
C reflections for analysis). The pointers are in
C elements IKEYS(5,i), i=1,NSORT
C NSORT number of sorted reflections to analyse
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Scalar Arguments ..
LOGICAL PROFILE
INTEGER NSORT
C ..
C .. Array Arguments ..
INTEGER*2 IKEYS(5,NSORT)
C ..
C .. Local Scalars ..
REAL FBAR,FSUM,FSUMTOT,RAT,XC,YC,XCAL,YCAL,
+ RFAC1,RFACT,SDRAT,SIGSQ,DSTSQ,
+ SIGST,SIGSUM,SIGTOT,SIGBAR,
+ VARBAR,W,WSUM,FWSUM,DELFSQ,DIFF,BAD,WORST,DPHIS,DPHIE
INTEGER I,IEND,IPAIR,IRECG,JR,M,NPAIRS,NDBG,NHKLS,IFLAG,
+ IXPX,IYPX,K,KSYM,MP,J,L,MPART,NBIN1
LOGICAL MATCH,FIRST
CHARACTER STR*14
C ..
C .. Local Arrays ..
REAL FMOD(20),FRBAR(10),FRBARR(20),RFACG(10),
+ RFACR(20),SDRATG(10),SDRATR(20),SIGIN(10),
+ SIGINR(20),SIGMOD(20),SIGSG(10),SIGSR(20),RFAC(10)
INTEGER IHKL(3),ISPAIR(20),KHKL(3),KRANGE(10),
+ KRANGR(20),NGPAIR(10),NRPAIR(20),IRECORD(20),
+ IXPIX(20),IYPIX(20),IHKLR(3,20)
C ..
C .. External Functions ..
LOGICAL HKLEQ
EXTERNAL HKLEQ
C ..
C .. External Subroutines ..
EXTERNAL GETBIN,ASUGET,MMTOPX
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,INT,MAX,MIN,REAL,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
C .. Equivalences ..
C ..
SAVE
C
NBIN1 = 8
NDBG = 0
FIRST = .TRUE.
C
IF (DEBUG(51)) THEN
WRITE(IOUT,FMT=6000) NSORT,PROFILE
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSORT,PROFILE
END IF
6000 FORMAT(/1X,'Enter RSYMM2',/,1X,'Nsort',I6,' Profile ',L1)
C---- Initialize
C
IEND = 0
NRSYM = 0
NHKLS = 0
IPAIR = 0
RFACT = 0.0
SIGST = 0.0
SIGTOT = 0.0
SDRAT = 0.0
NPAIRS = 0
FSUMTOT = 0.0
RFACOV = 0.0
C
C
DO 40 I = 1,20
ISPAIR(I) = 0
KRANGR(I) = 0
FRBARR(I) = 0.0
SIGSR(I) = 0.0
SIGINR(I) = 0.0
RFACR(I) = 0.0
SDRATR(I) = 0.0
NRPAIR(I) = 0
IF (I.GT.10) GO TO 30
KRANGE(I) = 0
FRBAR(I) = 0.0
SIGSG(I) = 0.0
SIGIN(I) = 0.0
RFACG(I) = 0.0
SDRATG(I) = 0.0
NGPAIR(I) = 0
30 CONTINUE
40 CONTINUE
C
JR = 0
C
C---- Loop for reflections
C
50 JR = JR + 1
IF (JR.GT.NSORT) THEN
IEND = 2
IF (IPAIR.LE.1) GO TO 200
IPAIR = IPAIR + 1
C
C---- Process last reflection
C
GO TO 90
END IF
C
C---- Get reflection pointer
C
IRECG = IKEYS(5,JR)
C
C---- Record numbers greater than 32767 will come out negative when
C stored as I*2
C
IF (IRECG.LT.0) IRECG = IRECG + 65536
C
KHKL(1) = IHG(IRECG)
KHKL(2) = IKG(IRECG)
KHKL(3) = ILG(IRECG)
C
IPAIR = IPAIR + 1
60 IF (PROFILE) THEN
FMOD(IPAIR) = IPRO(IRECG)
SIGMOD(IPAIR) = ISDPRO(IRECG)
ELSE
FMOD(IPAIR) = INTG(IRECG)
SIGMOD(IPAIR) = ISDG(IRECG)
END IF
IRECORD(IPAIR) = IRECG
XC = XG(IRECG)
YC = YG(IRECG)
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert from 10 micron units to pixels
C
IXPX = NINT(0.01*XCAL/RAST)
IYPX = NINT(0.01*YCAL/RAST)
C
C---- If Mar scanner, image has been stored in memory inverted right to left.
C Correct X coordinate for this.
IF (INVERTX) IXPX = NREC - IXPX + 1
IXPIX(IPAIR) = MAX(IXPX,1)
IYPIX(IPAIR) = MAX(IYPX,1)
C
C---- Get original indices
C
MP = MISYMG(IRECG)/256
KSYM = MISYMG(IRECG) - MP*256
CALL ASUGET(KHKL,IHKLR(1,IPAIR),KSYM)
C
IF (IPAIR.GT.1) GO TO 80
C
C
DO 70 I = 1,3
IHKL(I) = KHKL(I)
70 CONTINUE
C
C
GO TO 50
C
C---- Check same HKL, different symmetry
C
80 MATCH = HKLEQ(IHKL,KHKL)
IF (MATCH) GO TO 50
C
C---- Change of HKL, process set of fully recorded reflections
C
90 IPAIR = IPAIR - 1
IF (IPAIR.LT.2) GO TO 60
C
C---- Collect data for total statistics on intensities
C
C
C---- Set resolution BIN index = M from the first reflection in this
C set of symmetry related reflections
C
CALL GETBIN(IRECORD(1),M,NBIN1,DSTSQ)
C
ISPAIR(M) = ISPAIR(M) + IPAIR
120 FSUM = 0.0
FWSUM = 0.0
WSUM = 0.0
SIGSUM = 0.0
DELFSQ = 0.0
RFAC1 = 0.0
C
IF (DEBUG(51).AND.(NDBG.LT.NDEBUG(51))) THEN
NDBG = NDBG + 1
WRITE(IOUT,FMT=6002) IHKL,IPAIR,(FMOD(I),I=1,IPAIR)
IF (ONLINE) WRITE(ITOUT,FMT=6002)IHKL,IPAIR,(FMOD(I),I=1,IPAIR)
6002 FORMAT(1X,'Reflection',3I4,' has ',i3,' observations with',
+ ' Intensities:',/,(1X,8F10.1))
END IF
C
DO 130 I = 1,IPAIR
W = SIGMOD(I)
SIGSUM = W*W + SIGSUM
W = 1.0/ (W*W)
FWSUM = FMOD(I)*W + FWSUM
FSUM = FMOD(I) + FSUM
WSUM = WSUM + W
130 CONTINUE
C
C
FBAR = FWSUM/WSUM
VARBAR = 1.0/WSUM
SIGBAR = SQRT(VARBAR)
IFLAG = 0
WORST = 0.0
C
C
DO 150 I = 1,IPAIR
DIFF = ABS(FBAR-FMOD(I))
RFAC1 = RFAC1 + DIFF
DELFSQ = DIFF**2 + DELFSQ
BAD = DIFF/SIGMOD(I)
IF (BAD.LE.SDMON) GO TO 150
IFLAG = 1
WORST = MAX(BAD,WORST)
150 CONTINUE
C
C
SIGSQ = DELFSQ/IPAIR
NRSYM = NRSYM + IPAIR
SIGST = SIGST + SIGSQ
SIGTOT = SIGTOT + VARBAR
RFACT = RFACT + RFAC1
FSUMTOT = FSUMTOT + FSUM
NPAIRS = NPAIRS + 1
RAT = DELFSQ/SIGSUM
SDRAT = SDRAT + RAT
KRANGR(M) = KRANGR(M) + IPAIR
FRBARR(M) = FRBARR(M) + FSUM
SIGINR(M) = SIGINR(M) + VARBAR
SIGSR(M) = SIGSR(M) + SIGSQ
RFACR(M) = RFACR(M) + RFAC1
SDRATR(M) = SDRATR(M) + RAT
NRPAIR(M) = NRPAIR(M) + 1
C
C---- Print large differences (any observation more than SDMON sd's from
C weighted mean).
C
IF (IFLAG.EQ.0) GO TO 170
IF (FIRST) THEN
FIRST = .FALSE.
WRITE(IOUT,FMT=9024) SDMON
IF (ONLINE) WRITE(ITOUT,FMT=9024) SDMON
9024 FORMAT(/1X,'Monitored reflections (more than',F4.1,' sds',
+ ' from weighted mean)',//,1X,'DPHIS,DPHIE are the',
+ ' angular distance of the start of the spot from ',
+ ' start of the oscillation and the end of the spot',
+ /,1X,'from the end of the oscillation respectively.',/,
+ 1X,' h k l',6X,'IMEAN',6X,'SD Max dev ',
+ ' h k l',6X,'I',6X,'SD',4X,'IX IY',5X,
+ 'PHI WIDTH DPHIS DPHIE Status')
END IF
WRITE (IOUT,FMT=9020) (IHKL(J),J=1,3),FBAR,SIGBAR,WORST
IF (ONLINE) WRITE (ITOUT,FMT=9020) (IHKL(J),J=1,3),FBAR,
+ SIGBAR,WORST
9020 FORMAT (1X,3I4,F11.1,F8.1,F7.1)
DO 160 J = 1,IPAIR
MPART = IMPARTG(IRECORD(J))
DPHIS = PHIG(IRECORD(J)) - 0.5*PHIWG(IRECORD(J)) - PHIBEG
DPHIE = PHIEND - (PHIG(IRECORD(J)) + 0.5*PHIWG(IRECORD(J)))
IF (MPART.EQ.10) THEN
STR = 'Summed partial'
ELSE
STR = 'Fully recorded'
END IF
WRITE(IOUT,FMT=9022)(IHKLR(I,J),I=1,3),
+ FMOD(J),SIGMOD(J),IXPIX(J),IYPIX(J),PHIG(IRECORD(J)),
+ PHIWG(IRECORD(J)),DPHIS,DPHIE,STR
IF (ONLINE) WRITE(ITOUT,FMT=9022)(IHKLR(I,J),I=1,3),
+ FMOD(J),SIGMOD(J),IXPIX(J),IYPIX(J),PHIG(IRECORD(J)),
+ PHIWG(IRECORD(J)),DPHIS,DPHIE,STR
IF (BRIEF) WRITE(IBRIEF,FMT=9022)(IHKLR(I,J),I=1,3),
+ FMOD(J),SIGMOD(J),IXPIX(J),IYPIX(J),PHIG(IRECORD(J)),
+ PHIWG(IRECORD(J)),DPHIS,DPHIE,STR
160 CONTINUE
9022 FORMAT(39X,3I4,F9.0,F7.0,2I5,2F9.3,2F6.2,1X,A)
C
C
C
C
C---- Set Intensity RANGE index = M
C
170 DO 180 M = 1,9
IF (FBAR.LT.IRANGE(M)) GO TO 190
180 CONTINUE
C
C
M = 10
190 KRANGE(M) = KRANGE(M) + IPAIR
FRBAR(M) = FRBAR(M) + FSUM
SIGIN(M) = SIGIN(M) + VARBAR
SIGSG(M) = SIGSG(M) + SIGSQ
RFACG(M) = RFACG(M) + RFAC1
SDRATG(M) = SDRATG(M) + RAT
NGPAIR(M) = NGPAIR(M) + 1
NHKLS = NHKLS + 1
IPAIR = 1
IF (IEND-1.LT.0) GO TO 60
C
C---- Statistical data complete for that crystal
C
C
200 IF (NRSYM.LE.0) GO TO 210
IF (FSUMTOT.NE.0.0) RFACOV = RFACT/FSUMTOT
IF (NPAIRS.GT.0)SDRATOV = SQRT(SDRAT/NPAIRS)
GO TO 220
C
210 RFACT = 0.0
SDRATOV = 0.0
220 WRITE (IOUT,FMT=6010)
6010 FORMAT (/,1X,'Agreement between symmetry related fully recorded',
+ ' reflections',/,1X,'==================================',
+ '==========================')
IF (ONLINE) WRITE (ITOUT,FMT=6010)
IF (BRIEF) WRITE (IBRIEF,FMT=6010)
C
C---- Write INTENSITY groups (10 bins)
C KRANGE...Number of observations in this range
C NGPAIR...Number of unique hkl's in this range
C
DO 260 M = 1,10
RFAC(M) = 0.0
IF (KRANGE(M).LE.0) GO TO 260
IF (FRBAR(M).NE.0) RFAC(M) = RFACG(M)/FRBAR(M)
IF (NGPAIR(M).NE.0) SDRATG(M) = SDRATG(M) / NGPAIR(M)
IF (SDRATG(M).GT.0.0) SDRATG(M) = SQRT(SDRATG(M))
260 CONTINUE
C
WRITE(IOUT,FMT=6030) IRANGE
IF (ONLINE) WRITE(ITOUT,FMT=6030) IRANGE
6030 FORMAT(/,1X,' RANGES ',I6,I5,1X,3I6,1X,4I6,' Overall')
WRITE(IOUT,FMT=6032) (KRANGE(I),I=1,10),NRSYM
6032 FORMAT (1X,'Nobs ',10I6,I8)
WRITE(IOUT,FMT=6034) (NGPAIR(I),I=1,10),NHKLS
6034 FORMAT (1X,'Nhkls ',10I6,I8)
WRITE(IOUT,FMT=6036) (RFAC(I),I=1,10),RFACOV
6036 FORMAT (1X,'Rfactor',10F6.3,F8.3)
WRITE(IOUT,FMT=6038) (SDRATG(I),I=1,10),SDRATOV
6038 FORMAT (1X,'SDratio',10F6.2,F8.2)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=6032) (KRANGE(I),I=1,10),NRSYM
WRITE(ITOUT,FMT=6034) (NGPAIR(I),I=1,10),NHKLS
WRITE(ITOUT,FMT=6036) (RFAC(I),I=1,10),RFACOV
WRITE(ITOUT,FMT=6038) (SDRATG(I),I=1,10),SDRATOV
END IF
C
C---- Write RESOLUTION groups
C ISPAIR...Number of observations in this range
C NRPAIR...Number of unique hkl's in this range
C
C
DO 310 M = 1,8
RFAC(M) = 0.0
IF (ISPAIR(M).LE.0) GOTO 310
IF (FRBARR(M).NE.0) RFAC(M) = RFACR(M)/FRBARR(M)
IF (NRPAIR(M).NE.0) SDRATR(M) = SDRATR(M) / NRPAIR(M)
IF (SDRATR(M).GT.0.0) SDRATR(M) = SQRT(SDRATR(M))
310 CONTINUE
WRITE(IOUT,FMT=6040) (DBIN(I),I=1,8),(ISPAIR(I),I=1,8),
+ (NRPAIR(I),I=1,8),(RFAC(I),I=1,8),(SDRATR(I),I=1,8)
6040 FORMAT(/,1X,'Analysis as a function of resolution.',/,
+ 1X,'Res (Ang)',8F7.2,/,
+ 1X,'Profile fitted fully recorded:',/,
+ 1X,'Nobs ',8I7,/,
+ 1X,'Nhkl ',8I7,/,
+ 1X,'Rfactor ',8F7.3,/,
+ 1X,'SDratio ',8F7.2)
320 RETURN
C
C
END
C
C 26-Nov-1988 J. W. Pflugrath Cold Spring Harbor Laboratory
C Edited to conform to Fortran 77. Renamed from Rotation_matrices to
C RTMATS
C
C ==============================================================================
C
C! to calculate a rotation matrix and derivatives
C
SUBROUTINE RTMATS
C ! input: rotation angle
1 (ANGLE
C ! input: rotation axis
2 ,AXIS
C ! input: required number of derivatives
3 ,NDER
C ! output: rotation matrix and up to 4 requested derivatives
4 ,MATS)
IMPLICIT NONE
C
CEE Creates a rotation matrix and optional derivatives up to the 4th with
CEE respect to the angle of rotation. The direction of
CEE the input vector is taken as the axis down which the rotation represented
CEE by the matrix is seen to be clockwise,
CEE and the angle of rotation is taken to be in radians.
C rotation_matrices
Created: 14-NOV-1986 D.J.Thomas, MRC Laboratory of Molecular Biology,
C Hills Road, Cambridge, CB2 2QH, England
C - from dRotation_matrix routine
C rotation_matrices
C
C ! rotation angle / radians
REAL ANGLE
C ! cos(rotation angle)
REAL CSR
C ! loop counters
INTEGER I, J
C ! number of derivatives required (on [0,4])
INTEGER NDER
C ! sin(rotation angle)
REAL SNR
C ! 1-cos(rotation angle)
REAL VCR
C
C ! rotation axis (unit vector)
REAL AXIS (1:3)
C ! required rotation matrix and requested derivatives
REAL MATS (1:3,1:3,0:*)
C
CSR = COS(ANGLE)
VCR = 1.0 - CSR
SNR = SIN(ANGLE)
C
IF (NDER .LT. 0) THEN
C ! warning message, no other action necessary
PRINT *, 'RTMATS: negative number of derivatives?'
ENDIF
C
C ! evaluate the rotation matrix explicitly
MATS(1,1,0) = VCR * AXIS(1) * AXIS(1) + CSR
MATS(2,1,0) = VCR * AXIS(2) * AXIS(1) + SNR * AXIS(3)
MATS(3,1,0) = VCR * AXIS(3) * AXIS(1) - SNR * AXIS(2)
MATS(1,2,0) = VCR * AXIS(1) * AXIS(2) - SNR * AXIS(3)
MATS(2,2,0) = VCR * AXIS(2) * AXIS(2) + CSR
MATS(3,2,0) = VCR * AXIS(3) * AXIS(2) + SNR * AXIS(1)
MATS(1,3,0) = VCR * AXIS(1) * AXIS(3) + SNR * AXIS(2)
MATS(2,3,0) = VCR * AXIS(2) * AXIS(3) - SNR * AXIS(1)
MATS(3,3,0) = VCR * AXIS(3) * AXIS(3) + CSR
C
C ! evaluate the (4n+1)th derivative matrix explicitly
IF (NDER .GE. 1) THEN
MATS(1,1,1) = SNR * AXIS(1) * AXIS(1) - SNR
MATS(2,1,1) = SNR * AXIS(2) * AXIS(1) + CSR * AXIS(3)
MATS(3,1,1) = SNR * AXIS(3) * AXIS(1) - CSR * AXIS(2)
MATS(1,2,1) = SNR * AXIS(1) * AXIS(2) - CSR * AXIS(3)
MATS(2,2,1) = SNR * AXIS(2) * AXIS(2) - SNR
MATS(3,2,1) = SNR * AXIS(3) * AXIS(2) + CSR * AXIS(1)
MATS(1,3,1) = SNR * AXIS(1) * AXIS(3) + CSR * AXIS(2)
MATS(2,3,1) = SNR * AXIS(2) * AXIS(3) - CSR * AXIS(1)
MATS(3,3,1) = SNR * AXIS(3) * AXIS(3) - SNR
C
C ! evaluate the (4n+2)th derivative matrix explicitly
IF (NDER .GE. 2) THEN
MATS(1,1,2) = CSR * AXIS(1) * AXIS(1) - CSR
MATS(2,1,2) = CSR * AXIS(2) * AXIS(1) - SNR * AXIS(3)
MATS(3,1,2) = CSR * AXIS(3) * AXIS(1) + SNR * AXIS(2)
MATS(1,2,2) = CSR * AXIS(1) * AXIS(2) + SNR * AXIS(3)
MATS(2,2,2) = CSR * AXIS(2) * AXIS(2) - CSR
MATS(3,2,2) = CSR * AXIS(3) * AXIS(2) - SNR * AXIS(1)
MATS(1,3,2) = CSR * AXIS(1) * AXIS(3) - SNR * AXIS(2)
MATS(2,3,2) = CSR * AXIS(2) * AXIS(3) + SNR * AXIS(1)
MATS(3,3,2) = CSR * AXIS(3) * AXIS(3) - CSR
C
C ! evaluate the (4n+3)th derivative matrix
IF (NDER .GE. 3) THEN
DO 100 J = 1, 3
DO 100 I = 1, 3
C ! (4n+3)th derivative is minus (4n+1)th derivative
100 MATS(I,J,3) = - MATS(I,J,1)
CONTINUE
CONTINUE
C
C ! evaluate the (4n+4)th derivative matrix
IF (NDER .GE. 4) THEN
DO 200 J = 1, 3
DO 200 I = 1, 3
C ! (4n+4)th derivative is minus (4n+2)th derivative
200 MATS(I,J,4) = - MATS(I,J,2)
CONTINUE
CONTINUE
C
IF (NDER .GE. 5) THEN
PRINT *, 'RTMATS: > 4 derivatives requested!'
PRINT *, ' Only the first 4 have been evaluated '
PRINT *, ' since they repeat after this.'
PRINT *, ' Additionally, d3=-d1, d4=-d2.'
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
C
RETURN
END
C== RTOMISSET ==
C
C
C
C
SUBROUTINE RTOMISSET(R,PHI,IMODE)
C =============================
C
C
C---- Routine returns missetting angles PHI for a given rotation
C matrix R
C PHI returned in degrees (IMODE = 1)
C radians (IMODE = 2)
C
C [R] = [phiz] . [phiy] . [phix]
C
C | cz -sz 0 | | cy 0 sy | | 1 0 0 |
C [R] = | sz cz 0 | . | 0 1 0 | . | 0 cx -sx |
C | 0 0 1 | |-sy 0 cy | | 0 sx cx |
C
C
C | cz*cy cz*sy*sx-sz*cx cz*sy*cx+sz*sx |
C [R] = | sz*cy sz*sy*sx+cz*cx sz*sy*cx-cz*sx |
C | -sy cy*sx cy*cx |
C
C
C
C .. Array Arguments ..
REAL PHI(3),R(3,3)
C .. Scalar arguments ..
INTEGER IMODE
C ..
C .. Local Scalars ..
REAL ZILCH,DTOR,X
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,SIGN,ASIN,ATAN2,ATAN
C ..
SAVE
C
C
DTOR = ATAN(1.0)*4.0/180.0
ZILCH = 0.0000001
C
IF ((1.0-ABS(R(3,1))).LT.ZILCH) THEN
C
C---- Special case: sin(phiy)= +- 1 and thus cos(phiy) = 0
C Assume phix=0
C
PHI(1) = 0.0
PHI(2) = SIGN(90.0,-R(3,1))
PHI(3) = ATAN2(-R(1,2),R(2,2))
IF(IMODE.EQ.1)PHI(3) = PHI(3)/DTOR
ELSE
C
C
C---- General case: put phiy in range -90 to 90.
C Hence cos(phiy) is positive
C
X = -R(3,1)
IF (ABS(X).GT.1.0) X = SIGN(1.0,X)
PHI(2) = ASIN(X)
PHI(3) = ATAN2(R(2,1),R(1,1))
PHI(1) = ATAN2(R(3,2),R(3,3))
IF(IMODE.EQ.1)THEN
PHI(1) = PHI(1)/DTOR
PHI(2) = PHI(2)/DTOR
PHI(3) = PHI(3)/DTOR
END IF
ENDIF
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE SAVEINP
C ==================
C
IMPLICIT NONE
C
C---- Create an input file for a subsequent batch job, containing
C all parameters that have been changed during an interactive session.
C
C .. Parameters ..
INTEGER NPARM
PARAMETER (NPARM = 200)
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,J,K,ISAVE,IFAIL,NCH,NCHTOT,NOUT,ITILT,ITWIST
REAL DTOR,XTRUE,RMINXP
CHARACTER STR*80,LINE*80,KEY*4,SAVED(200)*80,KEY2*8,KEY3*8
C ..
C .. Local Arrays ..
INTEGER IFLAG(200)
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/parm2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm2.h
C---- START of include file parm2.h
C
C
C .. Scalars in common block /PARM2/ ..
REAL PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2
LOGICAL PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,PUPDATE,PKONLY,DENSE,PRFULLS,
+ DECONV
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
INTEGER IHD
C ..
C .. Common Block /PARM2/ ..
COMMON /PARM2/PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,
$ PKWDLIM3,PKWDOUTL,
$ ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2,
$ IHD(3,50),
$ PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,
+ PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,
+ PUPDATE,PKONLY,DENSE,
+ PRFULLS,DECONV
C ..
C
C
C&&*&& end_include ../inc/parm2.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
ISAVE = 12
IFAIL = 0
NOUT = 0
DTOR = ATAN(1.0)*4.0/180.0
DO 2 I = 1,200
IFLAG(I) = 0
2 CONTINUE
C
CALL CCPDPN (ISAVE,SAVENAM,'UNKNOWN','F',80,IFAIL)
IF (IFAIL.NE.0) THEN
WRITE(IOUT,FMT=1001) SAVENAM
IF (ONLINE) WRITE(ITOUT,FMT=1001) SAVENAM
1001 FORMAT(//,1X,'***** ERROR *****',/,1X,'Cannot open savefile ',
+ A)
RETURN
END IF
C
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1000)
1000 FORMAT('! This input created from an interactive session')
C
C---- First write out all input lines, excluding IMAGE and PROCESS
C
DO 10 I = 1,NTLINE-1
LINE = INLINE(I)
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) GOTO 10
KEY = LINE(IBEG(1):IEND(1))
CALL CCPUPC(KEY)
IF ((KEY.EQ.'IMAG').OR.(KEY(1:3).EQ.'RUN')
+ .OR.(KEY.EQ.'END').OR.(KEY.EQ.'GO')
+ .OR.(KEY.EQ.'PROC').OR.(KEY.EQ.'SERI')
+ .OR.(KEY.EQ.'CELL').OR.(KEY.EQ.'MISS')
+ .OR.(KEY.EQ.'SYMM').OR.(KEY.EQ.'STRA')
+ .OR.(KEY.EQ.'POST').OR.(KEY.EQ.'MOSA')
+ .OR.(KEY.EQ.'BEAM').OR.(KEY.EQ.'DIST')
+ .OR.(KEY.EQ.'SAVE')) THEN
CONTINUE
ELSE
NCH = LENSTR(LINE)
IF (NCH.GT.0) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1003) LINE(1:LENSTR(LINE))
END IF
END IF
10 CONTINUE
1003 FORMAT(A)
C
C
C---- Detector or SITE parameters
C
C
IF (IISCN) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1010) SVSCN(1:LENSTR(SVSCN))
END IF
1010 FORMAT('DETECTOR ',A)
IF (IISITE) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1012) SVSITE(1:LENSTR(SVSITE))
END IF
1012 FORMAT('SITE ',A)
IF (IIWAVE) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1014) WAVE
END IF
1014 FORMAT('WAVELENGTH',F9.5)
IF (IIDIV) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1016) 2.0*DIVH/DTOR,2.0*DIVV/DTOR
END IF
1016 FORMAT('DIVERGENCE',2F9.3)
IF (IIDISP) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1018) DELAMB
END IF
1018 FORMAT('DISPERSION',F9.5)
C
C---- Detector parameters (1020)
C
XTRUE = 0.01*XCEN
IF (INVERTX) XTRUE = NREC*RAST - XTRUE
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1020) XTRUE,0.01*YCEN/YSCAL
1020 FORMAT('BEAM',2F8.2)
C
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1022) GAIN
1022 FORMAT('GAIN',F5.2)
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1023) IDIVIDE
1023 FORMAT('ADCOFFSET',I4)
C
IF (IINULL) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1024) NULLPIX
END IF
1024 FORMAT('NULLPIX',I6)
C
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1026) XTOFD*XTOFRA*0.01
1026 FORMAT('DISTANCE',F9.3)
C
NOUT = NOUT + 1
ITILT = 0
ITWIST = 0
IF (FDIST.GT.0.0) THEN
ITILT = TILT/FDIST
ITWIST = TWIST/FDIST
END IF
IF (SPIRAL) THEN
IF (.NOT.FIXPAR(10)) THEN
WRITE(SAVED(NOUT),FMT=1070) YSCAL,0.01*ROFF,0.01*TOFF,
+ 0.01*RDROFF,0.01*RDTOFF,ITILT,ITWIST
1070 FORMAT('DISTORTION YSCALE',F9.4,' ROFF',F7.2,' TOFF',F7.2,
+ ' RDROFF',F7.2,' RDTOFF',F7.2,' TILT',I5,' TWIST',I5)
ELSE
WRITE(SAVED(NOUT),FMT=1072) YSCAL,0.01*ROFF,0.01*TOFF,
+ ITILT,ITWIST
1072 FORMAT('DISTORTION YSCALE',F9.4,' ROFF',F7.2,' TOFF',F7.2,
+ ' TILT',I5,' TWIST',I5)
END IF
ELSE
WRITE(SAVED(NOUT),FMT=1074) YSCAL,ITILT,ITWIST
1074 FORMAT('DISTORTION YSCALE',F9.4,' TILT',I5,' TWIST',I5)
END IF
IF (IIPIX) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1030) RAST
END IF
1030 FORMAT('PIXEL ',F8.5)
C
C
C---- Crystal parameters (1040)
C
IF (SAVMATSTR(1:7).NE.'Not set') THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1040) SAVMATNAM(1:LENSTR(SAVMATNAM))
1040 FORMAT('MATRIX ',A)
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1042) SAVMATSTR(1:LENSTR(SAVMATSTR))
1042 FORMAT('!This matrix was obtained from ',A)
IF (SAVMATSTR(1:1).EQ.'a') THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1044) (ISAVIMG(I),I=1,NSAVIMG)
1044 FORMAT('! The following images were used:',15I4)
ELSE IF (SAVMATSTR(1:1).EQ.'p') THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1046) NSAVSEG,(ISFIRST(I),I=1,NSAVSEG)
1046 FORMAT('!using ',I2,' segments starting with images',10I4)
END IF
END IF
C
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1048) NUMSPG
1048 FORMAT('SYMMETRY',I5)
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1049) 2.0*ETA/DTOR
1049 FORMAT('MOSAIC ',F5.2)
C
C---- Image parameters
C
NOUT = NOUT + 1
IF(TEMPLATE)THEN
WRITE(SAVED(NOUT),FMT=1061) TEMPLSAV(1:lenstr(templsav))
1061 FORMAT('TEMPLATE ',A)
ELSE
WRITE(SAVED(NOUT),FMT=1060) IDENT
1060 FORMAT('IDENT ',A)
ENDIF
NCHTOT = 10
STR = ' '
DO 30 I = 1,NDIR
IF (LENSTR(FDISK(I)).GT.0) THEN
NCH = LENSTR(FDISK(I))
IF ((NCHTOT+NCH).GT.80) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1062) STR(1:LENSTR(STR))
STR = FDISK(I)(1:NCH)
NCHTOT = 10 + NCH
ELSE
IF (I.EQ.1) THEN
STR = FDISK(I)(1:NCH)
ELSE
STR = STR(1:LENSTR(STR))//FDISK(I)(1:NCH)
END IF
NCHTOT = NCHTOT + NCH
END IF
END IF
30 CONTINUE
C
IF (NCHTOT.GT.10) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1062) STR(1:LENSTR(STR))
END IF
1062 FORMAT('DIRECTORY ',A)
IF(.NOT.TEMPLATE)THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1064) ODEXT
1064 FORMAT('EXTENSION ',A)
ENDIF
C
C---- Processing options
C
CAL IF (IIRAST) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1080) IRAS
CAL END IF
1080 FORMAT('RASTER ',5I5)
C
CAL IF (IISEP) THEN
NOUT = NOUT + 1
IF (DENSE) THEN
WRITE(SAVED(NOUT),FMT=1082) 0.01*IXSEP,0.01*IYSEP
ELSE
WRITE(SAVED(NOUT),FMT=1084) 0.01*IXSEP,0.01*IYSEP
END IF
CAL END IF
1082 FORMAT('SEPARATION ',2F5.2,' CLOSE')
1084 FORMAT('SEPARATION ',2F5.2)
C
CAL IF (IIOVER) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1086) CUTOFF
CAL END IF
1086 FORMAT('OVERLOAD CUTOFF ',I7)
C
RMINXP = 0.01*RMINX
IF (INVERTX) RMINXP = NREC*RAST - 0.01*RMINX
IF (IIBACK) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1088) RMINXP,0.01*RMINY,0.01*RMIN
END IF
1088 FORMAT('BACKSTOP CENTRE',2F8.2,' RADIUS',F6.2)
C
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1090) TOLMIN,TOL
1090 FORMAT('PROFILE TOLERANCE ',2F8.3)
IF (IIRES.AND.(RES.EQ.0.0)) THEN
C
C---- RES will be > 0 if set by keyword, but not if input from menu.
C
IF (DSTMAX.GT.0.0) THEN
NOUT = NOUT + 1
WRITE(SAVED(NOUT),FMT=1092) WAVE/DSTMAX
END IF
END IF
1092 FORMAT('RESOLUTION ',F6.2)
1094 FORMAT('RESOLUTION ',2F6.2)
C
C---- Now go though the lines and eliminate duplicates.
C
DO 50 I = NOUT,2,-1
C
C---- Is this line still a valid one
C
IF (IFLAG(I).EQ.0) THEN
LINE = SAVED(I)
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) GOTO 50
KEY3 = LINE(IBEG(1):IEND(1))
CALL CCPUPC(KEY3)
DO 40 J = I-1,1,-1
LINE = SAVED(J)
C ******************************************
CALL MPARSE(LINE,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) GOTO 40
KEY2 = LINE(IBEG(1):IEND(1))
CALL CCPUPC(KEY2)
IF (KEY2.EQ.KEY3) IFLAG(J) = 1
40 CONTINUE
END IF
50 CONTINUE
C
C---- Now write out wanted lines
C
DO 60 I = 1,NOUT
IF (IFLAG(I).EQ.0) WRITE(ISAVE,FMT=1100) SAVED(I)
60 CONTINUE
1100 FORMAT(A)
CLOSE(UNIT=ISAVE)
RETURN
END
C== SCALEPROF ==
C
SUBROUTINE SCALEPROF(IPROFL,IRAS,MASK,MASKREJ,SCALE,ODMIN,
+ PROFSUMS,WPROFSUMS)
C ===========================================================
C
C
C---- Remove the offset in profile so that mean background would
C be zero. rescale to a maximum of 10000.
C Evaluate and store sums for this profile
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
REAL ODMIN,SCALE
C ..
C .. Array Arguments ..
REAL PROFSUMS(4),WPROFSUMS(4)
INTEGER IRAS(5),MASK(MAXBOX),IPROFL(MAXBOX),MASKREJ(NREJMAX)
C ..
C .. Local Scalars ..
REAL A,B,C,SCALEP,SUMP,SUMPP,SUMPSQ,SUMQP,WSUMP,WSUMPP,WSUMPSQ,
+ WSUMQP,X
INTEGER HX,HY,IOD,K,P,Q,NBREJ,IJ,I,NXY
C ..
C .. Local arrays ..
INTEGER LMASK(MAXBOX)
C ..
C .. Intrinsic Functions ..
INTRINSIC REAL
C ..
C .. Common blocks ..
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(9),A), (ASPOT(10),B), (ASPOT(11),C)
C ..
C
SAVE
C
NXY = IRAS(1)*IRAS(2)
HX = IRAS(1)/2
HY = IRAS(2)/2
SUMPP = 0
SUMQP = 0
SUMP = 0
SUMPSQ = 0
C
C---- Set up mask which allows for rejected background points
C
C
DO 2 I = 1,NXY
LMASK(I) = 1
2 CONTINUE
C
NBREJ = MASKREJ(1)
DO 4 N = 1,NBREJ
IJ = MASKREJ(N+1)
LMASK(IJ) = 0
4 CONTINUE
C
C---- SCALEP scales corrected profile to peak value 10000
C
X = 10000.0/SCALE+ODMIN
IF (X.NE.0.0) THEN
SCALEP = 10000.0/X
ELSE
SCALEP = 1
END IF
K = 0
WSUMPP = 0.
WSUMQP = 0.
WSUMP = 0.
WSUMPSQ = 0.
C
C
DO 20 P = -HX,HX
DO 10 Q = -HY,HY
K = K + 1
IOD = (REAL(IPROFL(K))/SCALE+ODMIN)*SCALEP + 0.5
C
C---- NB allow negative profile values
C
IPROFL(K) = IOD
C
C---- Form sums for peak area
C
IF (MASK(K).GT.0) THEN
SUMP = SUMP + IOD
SUMPSQ = IOD*IOD + SUMPSQ
SUMPP = P*IOD + SUMPP
SUMQP = Q*IOD + SUMQP
END IF
C
C---- Form sums for all except rejected background pixels
C
IF (LMASK(K).GT.0) THEN
WSUMP = WSUMP + IOD
WSUMPSQ = IOD*IOD + WSUMPSQ
WSUMPP = P*IOD + WSUMPP
WSUMQP = Q*IOD + WSUMQP
END IF
C
C
10 CONTINUE
20 CONTINUE
C
C
PROFSUMS(1) = SUMPP
PROFSUMS(2) = SUMQP
PROFSUMS(3) = SUMP
PROFSUMS(4) = SUMPSQ
WPROFSUMS(1) = WSUMPP
WPROFSUMS(2) = WSUMQP
WPROFSUMS(3) = WSUMP
WPROFSUMS(4) = WSUMPSQ
C
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE SECTION
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM=200)
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/savall.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file savall.h
C
C NSAVIMG Number of images used in autoindexing
C ISAVIMG Array storing image numbers used in last autoindexing
C NSAVSEG Number of segments used in last postref run
C ISFIRST Array storing image number of the first image
C in all segments of last postref run.
C SAVMATSR Indicates whether last matrix was determined by
C autoindexing (Autoindexing) or by postref (Post refinement)
C SAVMATNAM Name of the matrix file
C SAVENAM Name of savefile
C SVSCN SCANNER keyword
C SVSITE SITE keyword
C RES High resolution limit given on RESOL keyword
C RESLOW Low resolution limit given on RESOL keyword
C
C .. Scalars in common block /SAVALL/ ..
REAL RES,RESLOW
INTEGER NSAVIMG,NDIR,NSAVSEG
CHARACTER SAVMATSTR*80,SAVMATNAM*80,SAVENAM*80,SVSCN*80,
+ SVSITE*80
LOGICAL IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C ..
C .. Arrays in common block /SAVALL/ ..
C
INTEGER ISAVIMG(MAXIMG),ISFIRST(100)
C .. Common Block /SAVALL/ ..
COMMON /SAVALL/ RES,RESLOW,ISAVIMG,ISFIRST,NSAVIMG,NDIR,NSAVSEG,
+ IISCN,IISITE,IIWAVE,IIDIV,IIDISP,IINULL,IIRAST,IISEP,
+ IIOVER,IIPIX,IIBACK,IIRES
C
C
COMMON /SAVALLC/ SAVMATSTR,SAVMATNAM,SAVENAM,SVSCN,SVSITE
C ..
C
C
C&&*&& end_include ../inc/savall.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/graphics.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file graphics.h
C---- START of include file graphics.h
C
C
C .. Scalars in common /GRAPHICS/ ..
REAL GRFACT,DISPLAY
INTEGER NGR,NGX,NGY,NHX,NHY,NLI
C ..
C .. Common block /GRAPHICS/ ..
COMMON /GRAPHICS/GRFACT,DISPLAY,NGR,NGX,NGY,NHX,NHY,NLI
C ..
C
C
C&&*&& end_include ../inc/graphics.f
C ..
C .. Scalar Arguments ..
INTEGER IFIRSTPACK,MODE
LOGICAL FIRSTTIME,GENOPEN,NEWGENF,RPTFIRST
CHARACTER CELLSTR*50
C ..
C .. Local Scalars ..
C
C EMBL
LOGICAL VERS1,VERS2,VERS3
C EMBL
C
REAL DTOR,OMEGA0,XLIMIT,THRESHF,XMMF,XMMDB,XCC,TEMP,
+ AXRMSLIM,XRMSLIM,RADEG,PHISTART,
+ X,XMAXIP,YMAXIP,RMAXIP,FXMAX,FYMAX,
+ VXMIN,VXMAX,VYMAX,VRMAX,THETA,ROFFMAX,XYOFF,DSTRMX,DSTRES,
+ DELR,T,RPLUS,THPLUS,XSEP,YSEP,XMAXRED,YMAXRED,RMAXRED,RSCAN,
+ RSCANRED,XDMID,YDMID,REDGE,RSCANIP,RMINIP,RMINRED,TORSRS,
+ COS2TH,DET,RSDMAX,RASTY,PHI1,PHI2,RMINP,DSTMINP,
+ OMEGADD,ETAD,DIVHD,DIVVD,PCCX,OVOLSCAL,RESEX1,RESEX2,
+ OMEGAFD,RAD,VOLSCAL,RMINXINP,CVOL,DEFVOL,XTRUE,YTRUE,
+ XYEXX1,XYEXY1,XYEXX2,XYEXY2,XTEST,OMEGAREV,XYMAXST,
+ DSTMAXST,THETAST,MAXCELL,reslim,sigma
INTEGER I,IADD,ICOMM,ID1,ID2,IDFILM,IFIRST,IFLAG,IPACK,
+ IPACK1,IPACK2,IPCKID,IPNT,ITINS,J,K,NC,NCASS,NCH,
+ NFIRSTF,NFP,NPROF,NPRUN,NRX,NRY,NSTR,NTOK,NTOK2,NXS,NYS,
+ ICOUNT,IFAIL,NCH2,NCH3,NCH4,NPROFAV,ITILT,ITWIST,
+ MODEOP,NCHAR,N,IMISS,IMISSMAT,LCRYS,
+ KEYPX,IPACKF,IPACKL,IDELAMB,IMOSAIC,ICCX,ICCY,
+ NSER,NSPG,IIDENT,
+ IBULGE,ICUT,IPRCUT,MTZPRT,
+ IPIX,ITOL,IPIXY,IYSCAL,INODES,
+ NP,IORGY,IORGZ,IPART,ICHECK,
+ IIPHI,IISIZE,IAUTO,IISTART,NSTRUNO,ISTAFLG,IENDFLG,IERR,
+ NSEGRD,NRLEFT,NRWORK,NSERRUN,NTIMES,
+ MODESP,ID,NIMAGP,NSOL,NIMAGES,IXOFFSET,IYOFFSET,
+ ISTOP,NAUTO,NMULTI,IMGKWD,IEXTEN,
+ IPROKWD,NPROCRUN,MODEGSR,IUN1,IUN2,INSIZE,ISIGSET,
+ IIONE, MINBATCH,NSEGOLD,INADD,INWIDTH,INSPEED,INMONO,
+ ISTRT2,IANGLE2,ITOR
LOGICAL ASSIGN,COMREAD,DONERUN,EFILE,ROTATED,OTHERS,
+ AVPR,EXPAND,PRINTL,FINE,DISPSET,RRSET,ARRSET,
+ STOPRUN,MTZOPN,PACK,FIXEDPR,
+ FASTH,FASTV,RESET,FINDSPOT,ROTH,ROTV,ROTANTI,ROTCLOCK,
+ ORGLR,ORGLL,ORGUR,ORGUL,SADDPART,SPOSTREF,SSUMPART,
+ INERR,CCXRESET,EXTRA,AUTOINDX,CELLKEEP,
+ LPRNT,FORCEREAD,ANGLES,BOXOPEN,UNPACK,FRSTWARN,
+ INPERR,TRAPERR,RFIXCELL,RFIXDIST,SAUTOINDX,NULINE,
+ READINLINE,SDPSINDEX,DPSDONE,SYMMIN,SAVIND
CHARACTER ABC*3,GRTYPE*3,KEY*4,STRL1*7,STR1*1,
+ HLPMOS*400,STRL2*10,KEY6*6,FIXSTR*80,
+ STR*20,STRL3*22,COMFILE*200,LINE*400,SITE*4,LINE2*80,
+ FWORK*200,SUBKEY*4,PROFFNR*100,
+ PROFFNW*100,PRINTOP(10)*24,SCAN*4,TEMPCH*134,KEY2*4,
+ IDXFILE*130,LATTYP*1,SCANNER*4,LINE80*80,STATION*4,
+ DEBUGSTR*120,SIDENT*40,KEY8*8,TARFILE*130,STR2*100,
$ CCP4VERSION,LINE100*100
C ..
C .. Local Arrays ..
REAL VALUE(NPARM),FIDXY(3,2),PX72(4),PX96(4),
+ TDELPHI(3),VALUE2(NPARM),
+ TCELL(6),AMATT(3,3),SUMAT(3,3),SBMAT(3,3),
+ WORK(3,3),UINV(3,3),WORK2(3,3),WORK3(3,3),SAMAT(3,3),
+ SDELPHI(3),SAVECELL(6),PHILEFT(40),PHISLEFT(40),
+ PHIRNGA(20),TARPHI(3),TMAT(3,3),TARCELL(6),TJUNK(3,3),
+ PKSUMS(6)
INTEGER IBEG(NPARM),IDEC(NPARM),IDPROF(MAXPAX),IEND(NPARM),
+ ITYP(NPARM),NCHPR(10),LCLASS(6,8),IFIX(NRPAR),
+ NFLEFT(40),NLLEFT(40),IDIMG(MAXIMG),IBEG2(NPARM),
+ IEND2(NPARM),ITYP2(NPARM),IDEC2(NPARM),IDAUTO(20),
+ ISERLEFT(40),MASK(MAXBOX)
LOGICAL UNFIX(6),PHISET(20)
CHARACTER DUMPSTR(5)*60,VERSTR(3)*6,SABC(6)*5,FIXSTRA(NRPAR)*10,
+ IDENTAUTO(20)*40
C ..
C .. External Functions ..
INTEGER LENSTR
LOGICAL VAXVMS
EXTERNAL LENSTR,VAXVMS
C ..
C .. External Subroutines ..
EXTERNAL CCPUPC,MKEYNM,MOSHLP,MPARSER,QCLOSE,UGTENV,OPENODS,
+ START,PSTART,SETMAT,CCPDPN,MINV33,MATMUL3,ROTMAT,
+ RTOMISSET,CELLCHK,CELLFIX,MTZINI,HEADERMTZ,ASUSET,
+ MRDSYMM,GETSPOTS,WSPOT,TOREFIX,TO_DPS_INDEX,GETBLOCK,
+ XDLF_FLUSH_EVENTS,GETSEPRAS,STARTMTZ,IMGOUT,TARGMAT,
+ WINDIO, ximage, xupdate, xfindspots
C ..
C .. Intrinsic Functions ..
C---- Check wavelength and distance for consistency with values in
C header
C ONLY does this for MAR and RaxisIV (and R-Axis 5) and JUPITER
C images at present.
C Separate checks are done for DIP2 images in subroutine GETTAIL
C
C ***** machine specific code follows *****
C AL IF ((MACHINE.EQ.'MAR '.AND.(.NOT.PACK)).OR.
C AL + (MODEL.EQ.'RAXISIV')) THEN
dtor = atan(1.0) / 45.0
IF (USEHDR) THEN
IF ((IDIST.GT.0).AND.(ABS(0.01*XTOFD - HDIST).GT.0.1))
+ THEN
WRITE(IOUT,FMT=6713) 0.01*XTOFD, HDIST
IF (ONLINE) WRITE(ITOUT,FMT=6713) 0.01*XTOFD, HDIST
END IF
6713 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'Input crystal to detector distance (',F7.2,
+ 'mm) does NOT agree with value in the image ',
+ 'header (',F7.2,'mm)',/,1X,'The input distance',
+ ' will be used.')
C
C---- If distance not specified, set to value from header
C
IF ((IDIST.EQ.0).AND.(HDIST.NE.0)) THEN
XTOFD = 100.0*HDIST
IDIST = 1
WRITE(IOUT,FMT=6717) HDIST
IF (ONLINE) WRITE(ITOUT,FMT=6717) HDIST
6717 FORMAT(/,1X,'Crystal to detector distance of',F8.2,
+ 'mm taken from image header')
END IF
C
C---- Check wavelength against input value (if given)
C
IF ((IWAVE.EQ.2).AND.(ABS(WAVE - HWAVE).GT.0.001)) THEN
WRITE(IOUT,FMT=6715) WAVE,HWAVE
IF (ONLINE) WRITE(ITOUT,FMT=6715) WAVE,HWAVE
END IF
6715 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'Input wavelength (',F6.4,
+ 'A) does NOT agree with value in the image ',
+ 'header (',F6.4,'A)',/,1X,'The input wavelength',
+ ' will be used.')
C
C---- If wavelength not specified, set to value from header if non-zero
C
IF ((IWAVE.EQ.0).AND.(HWAVE.NE.0)) THEN
WRITE(IOUT,FMT=6719) HWAVE
IF (ONLINE) WRITE(ITOUT,FMT=6719) HWAVE
6719 FORMAT(/,1X,'Wavelength of',F8.5,'A taken',
+ ' from image header')
WAVE = HWAVE
IWAVE = 1
END IF
C
C---- Check header pixel size
C
IF ((IPIX.EQ.0).AND.(HRAST.NE.0)) THEN
IF(MACHINE.NE.'JUPI')THEN
WRITE(IOUT,FMT=6726) HRAST
IF (ONLINE) WRITE(ITOUT,FMT=6726) HRAST
ELSE
WRITE(IOUT,FMT=67261) HRAST
IF (ONLINE) WRITE(ITOUT,FMT=67261) HRAST
END IF
6726 FORMAT(/,1X,'Pixel size of ',F6.4,'mm taken',
+ ' from image header.')
67261 FORMAT(/,1X,'Pixel size of ',F6.4,'mm calculated',
+ ' from image header.')
RAST = HRAST
IPIX = 1
END IF
C
C---- IF POLARISATION NOT SPECIFIED, use value from header (SBC1 only)
C
IF ((MACHINE.EQ.'SBC1').AND.(ITOR.EQ.0)) THEN
WRITE(IOUT,FMT=6727) HTOR
IF (ONLINE) WRITE(ITOUT,FMT=6727) HTOR
6727 FORMAT(/,1X,'Beam polarisation of ',F6.4,' taken',
+ ' from image header.')
TOR = HTOR
ITOR = 1
END IF
C
C---- Check pixel size against input value (if given)
C
IF ((IPIX.EQ.1).AND.(ABS(RAST - HRAST).GT.0.001)) THEN
WRITE(IOUT,FMT=6729) RAST,HRAST
IF (ONLINE) WRITE(ITOUT,FMT=6729) RAST,HRAST
END IF
6729 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'Input pixel size (',F6.4,
+ 'mm) does NOT agree with value in the image ',
+ 'header (',F6.4,'mm)',/,1X,'The input value',
+ ' will be used.')
C
C---- If NULLPIX set in header (Mar CCD) and not set by keyword, use
C the value from header
C
IF ((.NOT.IINULL).AND.(HNULLPIX.GT.0)) THEN
NULLPIX = HNULLPIX
WRITE(IOUT,FMT=6728) NULLPIX
IF (ONLINE) WRITE(ITOUT,FMT=6728) NULLPIX
6728 FORMAT(1X,'Nullpix value from header:',I5)
END IF
C
C---- Set start,end phi if not assigned on IMAGE keyword. Note that we
C may be doing autoindexing without specifying an IMAGE keyword, so
C must check this.
C
c hrp270202 IF (NIMAGES.GT.0) THEN
c hrp270202 IF (IANGLE.EQ.0) THEN
c hrp270202 PHIBEG = HPHIS
c hrp270202 PHIEND = HPHIE
c hrp270202 PHI(1) = 0.5*(PHIBEG+PHIEND)
c hrp270202 PHISTIM(1) = PHIBEG
C
C---- only do following if this _isn't_ a CBF file
C
c hrp270202 IF(MACHINE.NE.'CBF ')THEN
c hrp270202 WRITE(IOUT,FMT=6724) NIMAGES,HPHIS
C ,HPHIE
c hrp270202 IF (ONLINE) WRITE(ITOUT,FMT=6724)
C NIMAGES,
c hrp270202 $ HPHIS,HPHIE
c hrp270202 6724 FORMAT(/,1X,'Start and end phi values
C for ',
c hrp270202 + 'image',I3,' from image header are
C ',F8.2,
c hrp270202 + ' and',F8.2,' degrees.')
c hrp270202 END IF
C
C---- Check that oscillation angle from header is non-zero, if not give
C a warning
C
c hrp270202 IF ((PHIEND-PHIBEG).EQ.0.0) THEN
c hrp270202 WRITE(IOUT,FMT=6725)
c hrp270202 IF (ONLINE) WRITE(ITOUT,FMT=6725)
c hrp270202 6725 FORMAT(/,1X,'***** WARNING *****',/,
c hrp270202 + 1X,'***** WARNING *****',/,
c hrp270202 + 1X,'***** WARNING *****',/,
c hrp270202 + 1X,'***** WARNING *****',/,1X,
c hrp270202 + 'Oscillation angle derived from
C image ',
c hrp270202 + 'header is zero. If this is an
C oscillation',
c hrp270202 $ /,1X,' image, then the header
C information',
c hrp270202 $ ' is not correct. The phi values
C must be',
c hrp270202 $ /,1X,'given on the IMAGE',
c hrp270202 + ' (or PROCESS) keyword.',/,/)
c hrp270202 END IF
c hrp270202 ELSE
C
C---- Check that oscillation angle agrees
C
c hrp270202 IF (ABS(2.0*(PHI(1)-PHISTIM(1)) -
c hrp270202 + (HPHIE-HPHIS)).GT.0.01) THEN
c hrp270202 WRITE(IOUT,FMT=6722)
c hrp270202 + 2.0*(PHI(1)-PHISTIM(1)),(HPHIE
C -HPHIS)
c hrp270202 IF (ONLINE) WRITE(ITOUT,FMT=6722)
c hrp270202 + 2.0*(PHI(1)-PHISTIM(1)),(HPHIE
C -HPHIS)
c hrp270202 6722 FORMAT(1X,'***** WARNING *****',/,
c hrp270202 + 1X,'***** WARNING *****',/,
c hrp270202 + 1X,'***** WARNING *****',/,
c hrp270202 + 1X,'***** WARNING *****',/,1X,
c hrp270202 = 'Input oscillation angle of ',F8.3
C ,' deg',
c hrp270202 + 'rees does not agree with value
C from ima',
c hrp270202 + 'ge header',/,1X,'which gives',F8
C .3,
c hrp270202 + ' degrees',/,1X,'The input values
C will b',
c hrp270202 $ 'e used',/,/)
c hrp270202 END IF
c hrp270202 END IF
c hrp270202 END IF
END IF
IF (MODEL.EQ.'RAXISIV') THEN
IF (NREC.EQ.1500) THEN
RAST = 0.2
ELSE IF (NREC.EQ.3000) THEN
RAST = 0.1
ELSE IF (NREC.EQ.6000) THEN
RAST = 0.05
END IF
END IF
IF (MODEL.EQ.'RAXISV') THEN
IF (NREC.EQ.2000) THEN
RAST = 0.2
ELSE IF (NREC.EQ.4000) THEN
RAST = 0.1
ELSE IF (NREC.EQ.8000) THEN
RAST = 0.05
END IF
END IF
C
C ***** Next line specific for Mar scanner radius ***********
c hrp270202 IF (.NOT.DISPSET) DISPLAY = 90.0
IF (ONLINE) FILMPLOT(1) = .TRUE.
ONEFILE = .TRUE.
FHEADER = .FALSE.
C
C Do the NOFID stuff. Remember to add CCOM to OMEGA0
C
c hrp270202 IF(MACHINE.NE.'CBF ')OMEGAF = OMEGAFD*DTOR
OMEGA0 = OMEGAF + CCOM*DTOR
c COSOM0 = COS(OMEGA0)
c SINOM0 = SIN(OMEGA0)
NOFID = .TRUE.
ROTATED = .FALSE.
SCNSZ = 40.0*RAST
FACT = 0.4/SCNSZ
IF (IGAIN.EQ.0) GAIN = 1.0
IF (YSCAL.LT.0) YSCAL = 1.0
IF (XTOFRA.LT.0) XTOFRA = 1.0
C AL IF (NHEAD.EQ.-999) NHEAD = 1
C
C ***** machine specific code follows *****
C
IF (MACHINE .EQ. 'ADSC')THEN
C
C---- Quantum 4 in binned mode
C
IF (abs(RAST-0.1632).le.1e-5)THEN
TILEX(1) = 577
TILEY(1) = 577
TILEWX(1) = 2
TILEWY(1) = 2
ELSEIF (abs(RAST-0.0512).le.1e-5)THEN
C
C---- Quantum 210 unbinned
C
MODEL = 'Q210'
TILEX(1) = 2049
TILEY(1) = 2049
IF (XSCAN.EQ.9400) XSCAN = 10500
IF (YSCAN.EQ.9400) YSCAN = 10500
XMAXIP = 10500
YMAXIP = 10500
TILEWX(1) = 8
TILEWY(1) = 8
C
C---- Quantum 210 binned
C
ELSEIF (abs(RAST-0.1024).le.1e-5)THEN
TILEX(1) = 1025
TILEY(1) = 1025
IF (XSCAN.EQ.9400) XSCAN = 10500
IF (YSCAN.EQ.9400) YSCAN = 10500
XMAXIP = 10500
YMAXIP = 10500
TILEWX(1) = 4
TILEWY(1) = 4
C
C---- Quantum 315 unbinned
C
ELSEIF (abs(RAST-0.05127).le.1e-5)THEN
IF((IYLENGTH.LT.12288).OR.(IXWDTH.LT.6144))THEN
WRITE(IOUT,FMT=6650)
IF(ONLINE)WRITE(ITOUT,FMT=6650)
6650 FORMAT(76('*'),/,6(' FATAL ERROR'),/,6X,
$ 'You must change all occurrences',
$ ' of the lines ',/,/,12X,'PARAMETER (IXWDTH=8192)',
$ /,6X,'and',/,12X,'PARAMETER (IYLENGTH=4096)',/,6X,
$ 'to',/,12X,'PARAMETER (IXWDTH=12288)',/,
$ 6X,'and',/,12X,'PARAMETER (IYLENGTH=6144)',/,/,6X,
$ 'and rebuild the program in order to process ',
$ 'Quantum 315 unbinned images.',/,6X,'These lines ',
$ 'occur in the files:',/,/,12X,
$ 'mosflm_all_ip_inc.for',
$ /,12X,'control.f',/,12X,'celref.f',/,8X,
$ 'and reek.f.',/,/,6X,'You may also need to increa',
$ 'se the swap space on your machine',/,6X,
$ '(it must be more than ~150Mb)',/,/,76('*'))
CALL SHUTDOWN
ENDIF
MODEL = 'Q315'
TILEX(1) = 2049
TILEY(1) = 2049
IF (XSCAN.EQ.9400) XSCAN = 15750
IF (YSCAN.EQ.9400) YSCAN = 15750
XMAXIP = 15750
YMAXIP = 15750
TILEWX(1) = 8
TILEWY(1) = 8
C
C---- Quantum 315 binned
C
ELSEIF (abs(RAST-0.10254).le.1e-5)THEN
TILEX(1) = 1025
TILEY(1) = 1025
IF (XSCAN.EQ.9400) XSCAN = 15750
IF (YSCAN.EQ.9400) YSCAN = 15750
XMAXIP = 15750
YMAXIP = 15750
TILEWX(1) = 4
TILEWY(1) = 4
END IF
END IF
C
C ***** machine specific code follows *****
C
c hrp270202 IF ((SITE(1:3).EQ.'LMB').OR.((SITE.EQ.'EMBL').AND.
c hrp270202 + (SCANNER(1:3).EQ.'SCR'))) THEN
c hrp270202 NHEAD = 0
c hrp270202 IF (NREC.EQ.0) NREC = 1187
c hrp270202 IF (IYLEN.EQ.0) IYLEN = 1187
c hrp270202 IF (RSCAN.EQ.0.0) RSCAN = 8887
c hrp270202 IF (SCANNER.EQ.'SCR3') THEN
C
C---- Set defaults for Red scanner
C
c hrp270202 IF (RSCAN.EQ.0.0) RSCAN = RSCANRED
c hrp270202 IF (XLIMIT.EQ.0.0) THEN
c hrp270202 XLIMIT = 60.0
c hrp270202 LIMIT = 100* NINT(XLIMIT)
c hrp270202 END IF
c hrp270202 IF (IPIX.EQ.0) RAST = 0.187
c hrp270202 SCNSZ = 7.48
c hrp270202 FACT = 0.4/SCNSZ
c hrp270202 END IF
c hrp270202 END IF
C
IF (MACHINE.EQ.'RAXI') THEN
IF ((MODEL.EQ.'RAXISIV').OR.(MODEL.EQ.'RAXISV')) THEN
C AL IF ((IYSCAL.EQ.0).AND.(IPIXY.EQ.0)) YSCAL = 1.0
IF (IGAIN.EQ.0) GAIN = 1.0
C
C---- Set default ADC offset to 4
C
IF (IDIVIDE.EQ.8) IDIVIDE = 4
ELSE
FINE = (NREC.EQ.1900)
C
C---- YSCAL based on pixel sizes of 101.7mu in fast direction, 105mu in
C slow.
c hrp270202 IF ((IYSCAL.EQ.0).AND.(IPIXY.EQ.0)) YSCAL =
C 105.0/101.7
IF (IGAIN.EQ.0) GAIN = 5.0
END IF
ELSE IF (MACHINE.EQ.'MAR ') THEN
IF (NREC.EQ.0) NREC = 1200
IF (IYLEN.EQ.0) IYLEN = 1200
C
C---- Fuji scanners at CHESS
C
ELSE IF (MACHINE.EQ.'FUJI') THEN
IF (NREC.EQ.0) NREC = 2560
IF (IYLEN.EQ.0) IYLEN = 2048
C
C---- Mac Science DIP2000
C
ELSE IF (MACHINE.EQ.'DIP2') THEN
IF (NREC.EQ.0) NREC = 2500
IF (IYLEN.EQ.0) IYLEN = 2500
C
C---- LMB scanner (image assigned from header so no code needed)
C
ELSE IF (MACHINE.EQ.'LMB') THEN
CONTINUE
C
C---- ESRF CCD (image assigned from header so no code needed)
C
ELSE IF (MACHINE.EQ.'LMB') THEN
CONTINUE
END IF
C
NWORD = IYLEN
NBYTE = IYLEN*2
C
C---- Correct beam coordinates for swing angle if necessary
C NOTE : This code only executed when an IMAGE keyword has been
C given, so only need to consider one image
C AL not necessary XCENMM(1,1)=XMM(1)
C
C AL change to YCENMM YCENMM(1,1)=YSCAL*YMM(1)
C HRP watch for beam set from image header
IF(IBEAM.NE.3)YCENMM(1,1)=YSCAL*YCENMMIN(1)
IF ((TWOTHETA.NE.0.0).AND.(ISWUNG.EQ.0)) THEN
C AL XCENMM(1,1) = XCENMM(1,1) +
C AL + COS(OMEGAF)*0.01*XTOFD*TAN(TWOTHETA*DTOR)
C AL YCENMM(1,1) = YCENMM(1,1) +
C AL + SIN(OMEGAF)*YSCAL*0.01*XTOFD*TAN(TWOTHETA
C *DTOR)
XCENMM(1,1) = XCENMMIN(1) +
+ COS(OMEGAF)*0.01*XTOFD*TAN(TWOTHETA*DTOR)
YCENMM(1,1) = YCENMMIN(1) +
+ SIN(OMEGAF)*YSCAL*0.01*XTOFD*TAN(TWOTHETA*DTOR)
END IF
C
C---- machine specific code ---- JUPITER CCD
C
IF((MACHINE.EQ.'JUPI').OR.(MACHINE.EQ.'ADSC').OR.
$ (MACHINE.EQ.'BRUK'))THEN
IF(IBEAM.EQ.3)THEN
XCENMM(1,1) = HBEAMX
YCENMM(1,1) = HBEAMY
XCENMMIN(1) = HBEAMX
YCENMMIN(1) = HBEAMY
XMM(1) = HBEAMX
YMM(1) = HBEAMY
WRITE(IOUT,FMT=6080)HBEAMX,HBEAMY
IF(ONLINE)WRITE(ITOUT,FMT=6080)HBEAMX,HBEAMY
ELSE IF(IBEAM.EQ.2)THEN
IF((ABS(HBEAMX-XMM(1)).GT.1E-3).or.
$ (ABS(HBEAMY-YMM(1)).GT.1E-3))THEN
WRITE(IOUT,FMT=6082)XMM(1),YMM(1),
$ HBEAMX,HBEAMY
IF(ONLINE)WRITE(ITOUT,FMT=6082)XMM(1),YMM(1),
$ HBEAMX,HBEAMY
ELSE
WRITE(IOUT,FMT=6084)XMM(1),YMM(1)
IF(ONLINE)WRITE(ITOUT,FMT=6084)XMM(1),YMM(1)
END IF
6080 FORMAT(/,' Main beam position has been calculated as ',
$ F7.2,'mm ',F7.2,'mm ',
$ 'from parameters',/,' in the image header.',
$ 'You should check ',
$ 'these values carefully as they may',/,
$ ' be in error!',/)
6082 FORMAT(4(/,'***** WARNING *****'),/,
$ ' Input beam coordinates ',F7.2,'mm ',F7.2,
$ 'mm DO NOT agree with ',/,' those calcula',
$ 'ted from the image header (',F7.2,'mm ',
$ F7.2,'mm)',/)
6084 FORMAT(/,' Input beam coordinates ',F7.2,'mm ',
$ F7.2,'mm will be used',/)
END IF
END IF
C
C---- Set direct beam coordinates to middle of image if not supplied on
C a
C BEAM keyword
C
IF (IBEAM.EQ.0) THEN
XCENMM(1,1) = 0.5*NREC*RAST
YCENMM(1,1) = 0.5*IYLEN*RAST*YSCAL
XCENMMIN(1) = 0.5*NREC*RAST
YCENMMIN(1) = 0.5*IYLEN*RAST*YSCAL
XMM(1) = 0.5*NREC*RAST
YMM(1) = 0.5*IYLEN*RAST*YSCAL
END IF
C
C---- For Mar, Fuji (at chess) etc image plate data, correct direct beam
C X coordinate for inversion of image.
C Raster size is RAST mm
C
IF (INVERTX) THEN
DO 698 I = 1,MAXPAX
XCENMM(I,1) = NREC*RAST - XCENMMIN(I)
C
C---- Because we have to use XCENMMIN here, must apply correction
C for swung detectors
C
IF ((TWOTHETA.NE.0.0).AND.(ISWUNG.EQ.0)) THEN
XCENMM(I,1) = XCENMM(I,1) +
+ COS(OMEGAF)*0.01*XTOFD*TAN(TWOTHETA*DTOR)
END IF
698 CONTINUE
IF (RSCANX.NE.0.0) RSCANX = 100.0*NREC*RAST - RSCANX
c hrp270202 IF (RMINXINP.NE.0.0) RMINX = 100.0*NREC*RAST -
C RMINXINP
C
C---- Only change CCX if it was read in from input. It may have been
C passed from the previous round of a multi-segment post refinement
C in which case it MUST NOT be reset.
C
c hrp270202 IF ((ICCX.EQ.1).AND.(.NOT.CCXRESET)) THEN
c hrp270202 CCX = -CCX
c hrp270202 CCXRESET = .TRUE.
c hrp270202 END IF
END IF
C
C---- If detector is swung out, correct direct beam coordinates
C (if keyword SWUNG_OUT is given the beam coordinates are assumed
C to be those with the detector set at the given two-theta angle.
C
IF (ISWUNG.EQ.1) THEN
XCEN0 = NINT(100.0*XCENMM(1,1) -
+ COS(OMEGAF)*XTOFD*TAN(TWOTHETA*DTOR))
YCEN0 = NINT(100.0*YCENMM(1,1) -
+ SIN(OMEGAF)*XTOFD*TAN(TWOTHETA*DTOR))
ELSE
C AL XCEN0 = NINT(100.0*XMM(1))
XCEN0 = NINT(100.0*XCENMMIN(1))
IF (INVERTX) XCEN0 = NINT(100.0*(NREC*RAST-XCENMMIN(1)))
C AL YCEN0 = NINT(100.0*YMM(1))
YCEN0 = NINT(100.0*YCENMMIN(1))
END IF
C
C---- Find spots if requested
C
C
C---- Set up default radial background direction
C
ROTATED = ((ABS(OMEGAF/DTOR).LT.1.0).OR.
+ ((ABS(OMEGAF/DTOR-180.0)).LT.1.0))
C
chrp270202 IF ((IXOFFSET.EQ.0).AND.(IYOFFSET.EQ.0)) THEN
chrp270202 RADX = ROTATED
chrp270202 RADY = (.NOT.RADX)
chrp270202 END IF
C
C---- Assign a RMIN, RMAX if not defaulted, to 0.05 and 0.45 of image
C size
C
IF (ROTATED) THEN
IF (RMINSP.EQ.0) RMINSP = NREC*RAST*0.05
IF (RMAXSP.EQ.0) RMAXSP = NREC*RAST*0.45
ELSE
IF (RMINSP.EQ.0) RMINSP = IYLEN*RAST*0.05
IF (RMAXSP.EQ.0) RMAXSP = IYLEN*RAST*0.45
END IF
C
C---- Check for an offset detector, and if necessary, change the
C direction
C that the background strip is measured in.
C
IF ((ABS(XCENMM(1,1)-NREC*RAST*0.5).GT.0.045*NREC*RAST).AND.
+ (ROTATED)) THEN
RMINSP = SIGN(RMINSP,(NREC*RAST*0.5-XCENMM(1,1)))
RMAXSP = SIGN(RMAXSP,(NREC*RAST*0.5-XCENMM(1,1)))
END IF
IF ((ABS(YCENMM(1,1)-IYLEN*RAST*0.5).GT.0.045*IYLEN*RAST).AND.
+ (.NOT.ROTATED)) THEN
RMINSP = SIGN(RMINSP,(IYLEN*RAST*0.5-YCENMM(1,1)))
RMAXSP = SIGN(RMAXSP,(IYLEN*RAST*0.5-YCENMM(1,1)))
END IF
C
end
C== SECTOR ==
C
C
C
SUBROUTINE SECTOR(PSI,PHI,NSPOT,NRJ)
C ===================================
C
C
C
C---- Flags reflections lying outside a sector with half-angle
C phi centred at angle psi (must be 0 or 90).
C
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL PHI,PSI
INTEGER NRJ,NSPOT
C ..
C .. Local Scalars ..
REAL ACHI,CHI,DTOR,PI,X,Y
INTEGER I
C ..
C .. Local Arrays ..
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ATAN
C ..
C .. Common blocks ..
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C ..
C .. Equivalences ..
SAVE
C ..
C
C
PI = ATAN(1.0)*4.0
DTOR = PI/180.0
NRJ = 0
C
C
DO 10 I = 1,NSPOT
X = XG(I)
Y = YG(I)
C
C
IF (ABS(X).LT.0.001) THEN
ACHI = 90.0
ELSE
CHI = ATAN(Y/X)/DTOR
ACHI = ABS(CHI)
END IF
C
C
IF (ABS(ACHI-PSI).GE.PHI) THEN
NRJ = NRJ + 1
IRG(I) = 5
END IF
C
C
10 CONTINUE
C
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== SEEKRS ==
SUBROUTINE SEEKRS(IRFMIN,IRFINC,IXSHIFT,IYSHIFT,OVRLDS,
+ ADDPART)
C ======================================================
C
IMPLICIT NONE
C
C
C---- Searches outside of film for refinement spots.
C Image is divided into sectors (8) within which
C a fixed no. of spots (LBIN = 5 )should be found.
C The selection criterion is that I/sigma(I)
C must be .GE. SDFAC, where SDFAC is IRFMIN for the outermost
C bins and is incremented by IRFINC working inwards.
C Once LBIN spots have been found in a bin, the next bin
C is searched. IRFMIN should not be set too low, or only
C weak spots will be found even if strong ones are present.
C The coordinates of the spots are supplied by gensort
C and stored in arrays IREC,IX,IY in common /GENDATA/
C measures stripes from scanner into array BA.
C selects data for particular spots into array BB.
C Completed spots are tested for integrated intensity
C and separation.
C All spots are assumed to have maximum box size when allocating
C space in running buffer BB
C
C Last changed 10/7/89 to allow use of overloaded reflections
C Last changed 14/3/89 to allow for very few (or zero) reflections in
C outer bins which may occur when using BASA or CASA options
C
C
C
C DEBUG(5) for this S/R
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IRFINC,IRFMIN,IXSHIFT,IYSHIFT
LOGICAL OVRLDS,ADDPART
C ..
C .. Local Scalars ..
REAL DELX,DELY,SOD,C,BGND,SDIFAC,SDIINC,SDI,VARTOT,SDELX,SDELY
INTEGER HFWX,HFWY,I,IADDR,IAVOD,IBIN,IBLK,IFRST,
+ ILAST,IND,INDF,INDL,IPNT,ISEPN,J,KMN,KMX,LASTX,
+ LASTY,LBIN,MAXB,MAXN,MAXW,MINDL,MJ,N1,N2,NB,NBGND,NBIN,NC,
+ NECX,NECY,NJ,NOSPT,NPEAK,NRX,NRY,NSIZ,NXS,NXX,NXY,NYS,NYY,
+ RC,SBIN,SHX,SHY,XC,YC,NBGBAD,NBGBADG,NRSAVE,IIXX,IIYY,
+ IRFMINO,IRFINCO,NPBOX,IPART,II,IFLAG,NZPBAD,IADD
LOGICAL FULL,VALONGY
C ..
C .. Local Arrays ..
INTEGER INF1(200),INF2(200),INF3(200),LRAS(5),PNTR(120),REC(200),
+ X(200),Y(200)
INTEGER*2 BB(MAXBUFF)
C ..
C .. External Subroutines ..
EXTERNAL BSWAP,CGFIT,ODPLOT,RDBLK,SIZRAS,GETBOX,BSWAP2,
+ XDLF_FLUSH_EVENTS
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MOD
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C Extra common blocks
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
COMMON /XYSCAN/ IIXX,IIYY
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (BB,IDUM)
EQUIVALENCE (LRAS(1),NXX), (LRAS(2),NYY)
EQUIVALENCE (ASPOT(11),C)
SAVE
C ..
C
C
VALONGY = (VEE .AND. (.NOT.VALONGX))
C
C
DO 10 I = 3,5
LRAS(I) = IRAS(I)
10 CONTINUE
C
NBGBAD = 0
NBGBADG = 0
NZPBAD = 0
NRSAVE = NRS
C
C---- Set maximum raster size in words
C
IF (IMGP) THEN
MAXW = MAXR
MAXB = MAXW
ELSE
MAXW = (MAXR+1)/2
MAXB = 2*MAXW
END IF
MAXN = MAXBUFF/MAXW
C
C---- Limit max number of active reflections to 100
C
IF (MAXN.GT.100) MAXN = 100
C
C---- Get information on spots from sort file
C
C ************************
CALL SIZRAS(IRAS,NPEAK,NBGND)
C ************************
C
NECX = XCEN*FACT + 0.5
NECY = YCEN*FACT + 0.5
LBIN = 5
NBIN = 8
SBIN = NREF/NBIN
IADD = 1
C
C---- Trap case where there are fewer reflections than bins
C
IF (SBIN.EQ.0) SBIN = 1
C
C---- Limit number of reflection per bin to 200. If more than this,
C skip reflections in input list
C
IF (SBIN.GT.200) THEN
IADD = NREF/(8*200)+ 1
SBIN = NREF/(IADD*NBIN)
END IF
C
C
IF (ONLINE) WRITE (ITOUT,FMT=6000) NREF,NBIN
ISEPN = 200/SCNSZ
C
C---- IPNT keeps track of position in sorted list from gensort
C
15 IPNT = 1
SDIFAC = IRFMIN
SDIINC = IRFINC
LASTX = 0
LASTY = 0
C
IF (DEBUG(5)) THEN
WRITE(IOUT,FMT=6020) NREF,NBIN,SBIN,LBIN,IADD
IF (ONLINE) WRITE(ITOUT,FMT=6020) NREF,NBIN,SBIN,LBIN,IADD
6020 FORMAT(//1X,'SEEKRS',/,1X,'NREF=',I6,' NBIN=',I4,' SBIN=',
+ I4,' LBIN=',I4,' IADD=',I4)
END IF
C
DO 100 NB = 1,NBIN
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C---- Trap case where there are fewer reflections than bins
C
IF (IPNT.LE.NREF) THEN
C
C
DO 20 NOSPT = 1,SBIN
RC = IREC(IPNT)
XC = IX(IPNT)
YC = IY(IPNT)
IPNT = IPNT + IADD
C
C---- Get the raster parameters and box number for this reflection
C
C ***********************************
CALL GETBOX(XC,YC,NXX,NYY,NPBOX)
C ***********************************
HFWX = NXX/2
HFWY = NYY/2
C
C---- Apply box shift ixshift,iyshift
C
X(NOSPT) = XC + IXSHIFT
Y(NOSPT) = YC + IYSHIFT
REC(NOSPT) = RC
INF1(NOSPT) = 2*HFWX + 1
INF2(NOSPT) = HFWX
INF3(NOSPT) = HFWY
20 CONTINUE
C
C---- Set flags to initial values
C IFRST,ILAST:-
C IFRST is the pointer to the next reflection in list to be
C processed (range 1 to SBIN)
C ILAST
C is pointer to the last reflection to have been finished
C and is used to calculate pointer into BB to get OD's for
C a spot which has just finished. ILAST would also range
C from 0 to SBIN-1, but is reset to zero when it reaches MAXN,
C thus ranges 0 to MAXN-1.
C INDF,INDL:-
C Pointers to active reflections (range 1 to SBIN)
C
INDF = 1
INDL = 1
IBIN = 0
IFRST = 1
ILAST = 0
30 CONTINUE
C
C---- Start scan for the first spot or spot after a gap
C
IBLK = X(INDF) - INF2(INDF)
40 CONTINUE
C
C---- Include the spot in this scan
C
C ****************
CALL RDBLK(IBLK)
C ****************
C
50 CONTINUE
C
C
IF (INDL.NE.SBIN) THEN
IF (.NOT.FULL) THEN
C
C---- See if next reflection in list has become active
C
MINDL = INDL + 1
C
C
IF (IBLK.GE.X(MINDL)-INF2(MINDL)) THEN
INDL = INDL + 1
IF (INDL-INDF.EQ.MAXN-1) FULL = .TRUE.
GO TO 50
END IF
END IF
END IF
C
C---- Get the information for this scan and start a new one
C
C
C---- Transfer ods of spots collected in this stripe to bb
C
IF (INDL.GE.INDF) THEN
C
C
DO 60 J = INDF,INDL
C
C---- MJ is pointer for reflection J, range 1 to MAXN
C
MJ = MOD(J-1,MAXN) + 1
YC = Y(J)
KMN = YC - INF3(J)
KMX = INF3(J) + YC
C
C
IF (J.EQ.IFRST) THEN
C
C---- If this reflection has just started,
C set byte pointer (PNTR) into BB.
C
C---- NJ is byte pointer to start address for reflection J (MJ)
C
C---- PNTR(J) gives current address in BB for relection J (MJ)
C
NJ = (MJ-1)*MAXB
PNTR(MJ) = NJ + 1
IFRST = IFRST + 1
END IF
C
C
IADDR = PNTR(MJ)
C
C ********************
CALL BSWAP(KMN,KMX,IADDR)
C ********************
C
C---- Add in second part for summed partials
C
IF (ADDPART.AND.(REC(J).LT.0)) THEN
C
C Reset IADDR (incremented in BSWAP)
IADDR = IADDR - (KMX - KMN + 1)
C *******************
CALL BSWAP2(KMN,KMX,IADDR)
C *******************
END IF
C
C---- note IADDR is incremented in BSWAP
C
PNTR(MJ) = IADDR
INF1(J) = INF1(J) - 1
60 CONTINUE
C
C
END IF
C
C
IBLK = IBLK + 1
70 CONTINUE
C
C---- See if spot is finished
C
IF (INF1(INDF).EQ.0) THEN
C
C---- Find c of g of spot and store coordinates
C
IND = ILAST*MAXW + 1
NXX = INF2(INDF)*2 + 1
NYY = INF3(INDF)*2 + 1
NXY = NXX*NYY
IIXX = X(INDF)
IIYY = Y(INDF)
C
C---- Extract degree of partiality for CGFIT
C
II = REC(INDF)
IF (II.LT.0) II = -II
IPART = IMG(II)
IF (ADDPART) IPART = 0
IF (DEBUG(5)) THEN
WRITE(IOUT,6100) NB,SBIN,INDF,INDL,ILAST,MAXW,II,IPART
IF (ONLINE) WRITE(ITOUT,6100) NB,SBIN,INDF,INDL,ILAST,
+ MAXW,II,IPART
6100 FORMAT(1X,'NB=',I3,' SBIN',I3,' INDF',I4,' INDL',I4,
+ ' ILAST',I4,' MAXW',I6,'Genfile record no',I6,
+ ' IPART',I4)
C IF (SPOT) CALL ODPLOT(BB(IND),NXX,NYY,1)
END IF
C
C ************************************
CALL CGFIT(BB(IND),LRAS,+1,DELX,DELY,SOD,SDELX,SDELY,IPART,
+ IFLAG)
C ************************************
C
C
C---- Reject reflections with too steep gradient
C
IF (IFLAG.EQ.1) THEN
NBGBADG = NBGBADG + 1
GOTO 75
END IF
C
C---- Reject reflections with too many background points rejected
C
IF (IFLAG.EQ.2) THEN
NBGBAD = NBGBAD + 1
GOTO 75
END IF
C
C---- Reject reflections containing zero value pixels (outside scanned
C area)
IF (IFLAG.EQ.3) THEN
NZPBAD = NZPBAD + 1
GOTO 75
END IF
C
C
C---- Test for overloads (IFLAG=4)
C
IF ((IFLAG.NE.4) .OR. OVRLDS) THEN
C
C---- Test for weak reflections (note..npeak is number of pixels in
C central (unexpanded) box).
C
C---- Calculate Intensity/sd to test for suitable spots
C First get number of peak and background pixels
C ************************
CALL SIZRAS(LRAS,NPEAK,NBGND)
C ************************
C
BGND = C*NPEAK
VARTOT=GAIN*(SOD+BGND+BGND*NPEAK/NBGND)
IF (VARTOT.LT.0) VARTOT = 0.0
SDI = SQRT(VARTOT)
IF (SOD.GT.SDIFAC*SDI) THEN
C
C
C
C---- Spot separation > 4 mm
C
IF (ABS(X(INDF))-LASTX.GE.ISEPN) LASTY = 0
C
C
IF (ABS(Y(INDF)-LASTY).GE.ISEPN) THEN
LASTX = X(INDF)
IBIN = IBIN + 1
NSIZ = (PNTR(ILAST+1)+1)/2
SHX = (DELX+IXSHIFT)/FACT + 0.5
SHY = (DELY+IYSHIFT)/FACT + 0.5
NRS = NRS + 1
LASTY = Y(INDF)
XRS(NRS) = (X(INDF)+DELX)/FACT
YRS(NRS) = (Y(INDF)+DELY)/FACT
RRS(NRS) = REC(INDF)
WXRS(NRS) = SDELX/FACT
WYRS(NRS) = SDELY/FACT
C
C
IF (DEBUG(5)) THEN
WRITE (IOUT,FMT=6002) NRS,SHX,SHY,XRS(NRS),
+ YRS(NRS),RRS(NRS),NXX,NYY,SOD,SDI,SDIFAC,
+ SDELX/FACT,SDELY/FACT
IF (ONLINE) WRITE (ITOUT,FMT=6002) NRS,SHX,SHY,
+ XRS(NRS),YRS(NRS),RRS(NRS),NXX,NYY,SOD,SDI,SDIFAC,
+ SDELX/FACT,SDELY/FACT
IF (SPOT) CALL ODPLOT(BB(IND),NXX,NYY,1)
END IF
C
END IF
C
C---- below is End of SOD.GT.SDIFAC*SDI block
C
END IF
C
C---- End of IFLAG.NE.4 block
C
END IF
C
C
75 ILAST = ILAST + 1
IF (ILAST.EQ.MAXN) ILAST = 0
INDF = INDF + 1
C
C
IF (IBIN.EQ.LBIN) THEN
GO TO 90
ELSE IF (INDF.LT.SBIN) THEN
GO TO 70
ELSE
GO TO 80
END IF
C
C
END IF
C
C
IF (INDF.LE.INDL) GO TO 40
FULL = .FALSE.
GO TO 30
C
80 NWRN = NWRN + 1
WRITE (IOUT,FMT=6004) IBIN,NB
IF (ONLINE) WRITE (ITOUT,FMT=6004) IBIN,NB
C
C
90 IF (NB.EQ.NBIN/2) THEN
SDIINC = -SDIINC
SDIFAC = SDIFAC - SDIINC
END IF
C
C
SDIFAC = SDIFAC + SDIINC
END IF
100 CONTINUE
C
C---- If not enough reflections, reduce threshold but not below
C 2 sigma
C
IF (NRS.LT.50) THEN
IF (IRFMIN.GT.2) THEN
IRFMINO = IRFMIN
IRFINCO = IRFINC
IF (NRS.GT.40) THEN
IRFMIN = NINT(0.75*IRFMIN)
IRFINC = NINT(0.75*IRFINC)
ELSE IF (NRS.GT.30) THEN
IRFMIN = NINT(0.5*IRFMIN)
IRFINC = NINT(0.5*IRFINC)
ELSE
IRFMIN = NINT(0.25*IRFMIN)
IRFINC = NINT(0.25*IRFINC)
END IF
IF (IRFMIN.LT.2) IRFMIN = 2
IF (IRFINC.GT.IRFMIN) IRFINC = IRFMIN
WRITE(IOUT,FMT=6010) NRS,IRFMINO,IRFMIN,IRFINCO,IRFINC
IF (ONLINE) WRITE(ITOUT,FMT=6010) NRS,IRFMINO,IRFMIN,
+ IRFINCO,IRFINC
IF (BRIEF) WRITE(IBRIEF,FMT=6011)
6010 FORMAT(/1X,'Only',I3,' reflections found (including those from',
+ ' central region',/,1X,'Reducing I/sigma(I) threshold ',
+ 'from',I3,' to',I3,' and increment from',I3,' to',I3,
+ /1X,'These reduced values will be used on all subsequent',
+ ' images',/,1X,'These parameters can be set using ',
+ 'subkeyword IMIN on REFINEMENT keyword')
6011 FORMAT(1X,'Insufficient spots found, reducing threshold')
NRS = NRSAVE
NBGBAD = 0
NBGBADG = 0
NZPBAD = 0
GOTO 15
END IF
END IF
C
C
IF (NBGBAD.NE.0) THEN
WRITE (IOUT,FMT=6006) NBGBAD,BGFREJ
6006 FORMAT (//1X,I3,' reflections rejected because more than a ',
1 'fraction',F5.2,' of the background pixels were rejected')
IF (ONLINE) WRITE (ITOUT,FMT=6006) NBGBAD,BGFREJ
END IF
IF (NBGBADG.NE.0) THEN
WRITE (IOUT,FMT=6008) NBGBADG,GRADMAXR
6008 FORMAT (//1X,I3,' reflections rejected because the gradient',
1 '/(average background) is greater then',F6.3)
IF (ONLINE) WRITE (ITOUT,FMT=6008) NBGBADG,GRADMAXR
END IF
IF (NZPBAD.GT.20) THEN
WRITE (IOUT,FMT=6014) NZPBAD,NULLPIX
6014 FORMAT (//1X,I3
$ ,' reflections have been rejected because the '
$ ,' measurement box contains',/,1X
$ ,'pixels with values less or equal to',I5,
+ ' (assumed to '
$ ,'be outside the scanned area).',/,1X,
+ 'See warning at end of logfile or in summary file.')
IF (ONLINE) WRITE (ITOUT,FMT=6014) NZPBAD,NULLPIX
END IF
C
C---- Format statements
C
6000 FORMAT (I6,' Reflections to be measured in',I4,' bins')
6002 FORMAT (1X,'Selected refinement spot number',I4,
+ ' C.OF G. SHIFTS',2I6,
+ ' XRS,YRS',2F8.1,' RRS ',I5,' NX,NY',2I3,' I,SIGI,SDFAC',
+ 2F7.0,F5.1/,1X,'SIGX,SIGY',2F7.2)
6004 FORMAT (' ONLY',I6,' spots found in bin',I4)
C
C
END
C== SETAX ==
C
C
C
C
C
SUBROUTINE SETAX(BBEG,BEND,IAX)
C ================================
C
C
C
C---- Determine order of axes for subroutine REEKE
C Routine returns IAX where
C
C IAX(3) r.l. axis most nearly parallel/antiparallel to Z
C (along rotation axis away from spindle)
C
C IAX(1) remaining r.l. axis most nearly parallel/antiparallel
C to X (along xray beam)
C
C IAX(2) remaining r.l. axis
C
C
C
C
C .. Array Arguments ..
REAL BBEG(3,3),BEND(3,3)
INTEGER IAX(3)
C ..
C .. Local Scalars ..
REAL C,CMAX,D
INTEGER I
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,SQRT
C ..
C
C
C---- Determine IAX(3) ie recip. lattice axis closest (parallel or
C anti-parallel) to the rotation (z) axis.
C (We actually determine the cosine of the angle)
C
CMAX = 0.0
C
C
DO 10 I = 1,3
D = SQRT(BBEG(1,I)**2+BBEG(2,I)**2+BBEG(3,I)**2)
C = ABS((BBEG(3,I)+BEND(3,I))/ (2.0*D))
C
C
IF (C.GT.CMAX) THEN
CMAX = C
IAX(3) = I
END IF
C
C
10 CONTINUE
C
C---- Now determine IAX(1) ie recip. lattice axis closest (parallel or
C anti-parallel) to the X axis or the X-ray beam
C
CMAX = 0.0
C
C
DO 20 I = 1,3
C
C
IF (I.NE.IAX(3)) THEN
D = SQRT(BBEG(1,I)**2+BBEG(2,I)**2+BBEG(3,I)**2)
C = ABS((BBEG(1,I)+BEND(1,I))/ (2.0*D))
C
C
IF (C.GT.CMAX) THEN
CMAX = C
IAX(1) = I
END IF
END IF
C
C
20 CONTINUE
C
C---- Set IAX(2) to the remaining axis
C
DO 30 I = 1,3
C
C
IF (IAX(1).NE.I) THEN
IF (IAX(3).NE.I) IAX(2) = I
END IF
C
C
30 CONTINUE
C
C
END
C
C
SUBROUTINE SETDD(DISTANCE, THETA, S0, DD, DDINV, DN)
C ====================================================
C
c set matrices etc for prediction (outside madnes)
c
c
c input:
c distance detector distance (mm)
c theta detector angle (degress)
c
c output:
c s0 source vector
c dd detector matrix
c ddinv inverse detector matrix
c dn detector normal
c
IMPLICIT NONE
C
REAL DISTANCE, THETA, WAVELENGTH
REAL S0(3), DDINV(3,3), DN(3)
C
REAL DD(3,3)
REAL DET
INTEGER R(3), W(3)
C
C
C source
S0(1) = 0.0
S0(2) = 0.0
S0(3) = 1.0
C detector rotation
CALL DDMAT(DISTANCE, THETA, DD, DN)
C inverse
CALL MOVEIT(DD,DDINV,9)
CALL MINV(DDINV, 3, DET, R, W)
C
RETURN
END
SUBROUTINE SETDIS(ITILT,ITWIST,IMODE)
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C---- subroutine to convert real values of tilt and twist to integer values
C for i/o in CONTROL.F etc, using either new method or old method.
C
C
C.. Integer arguments
INTEGER ITILT,ITWIST,IMODE
C
C.. Real arguments
c REAL TILT,TWIST
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/tiltlog.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- awk generated include file tiltlog.h
C---- START of include file tiltlog.h
C
C for things connected with the new definitions of TILT and TWIST
C
C .. Scalars in common block /TILTLOG/ ..
LOGICAL NUTWIST
COMMON /TILTLOG/NUTWIST
C&&*&& end_include ../inc/tiltlog.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C
C.. Local scalars
REAL DTOR
C
C.. External subroutines
EXTERNAL ROTMAT2
DTOR = ATAN(1.0)*4.0/180.0
IF(XTOFD.NE.0)FDIST = DTOR/(XTOFD * 100.0)
C
C----
C
c if(online)write(itout,fmt=1020)nutwist,fdist,xtofd,ITILT,
c $ ITWIST,TILT,TWIST,IMODE
IF(NUTWIST)THEN
IF(IMODE.EQ.1)THEN
TILT = FLOAT(ITILT) * 1E-2
TWIST = FLOAT(ITWIST) * 1E-2
CALL ROTMAT2(DETNOR,TILT,TWIST)
ELSE IF (IMODE.EQ.2)THEN
ITILT = NINT(TILT*1E02)
ITWIST = NINT(TWIST*1E02)
ELSE
WRITE(IOUT,1010)
IF(ONLINE)WRITE(ITOUT,1010)
CALL SHUTDOWN
ENDIF
ELSE
IF(IMODE.EQ.1)THEN
TILT = REAL(ITILT)*FDIST
TWIST = REAL(ITWIST)*FDIST
ELSE IF (IMODE.EQ.2)THEN
IF(FDIST.NE.0.0)THEN
ITILT = NINT(TILT/FDIST)
ITWIST = NINT(TWIST/FDIST)
ELSE
WRITE(IOUT,FMT=1000)
IF(ONLINE)WRITE(ITOUT,FMT=1000)
ENDIF
ELSE
WRITE(*,*)'MODE MUST BE 1 or 2; programmer error!'
CALL SHUTDOWN
ENDIF
ENDIF
c if(online)write(itout,fmt=1030)nutwist,fdist,xtofd,ITILT,
c $ ITWIST,TILT,TWIST,IMODE
RETURN
1000 FORMAT(3(5('*'),3(' WARNING '),5('*'),/),1X,'Crystal ',
$ 'to detector distance undefined, therefore TILT ',
$ 'and TWIST are undefined - set to ZERO')
1010 FORMAT('Error in SETDIS; IMODE MUST BE 1 or 2',/,'Programm',
$ 'er error in calling routine!')
1020 FORMAT(/,' Before: ',L1,F8.3,1X,F8.0,1X,2(I4,1X),2(F12.8,1X),I1)
1030 FORMAT(' After: ',L1,F8.3,1X,F8.0,1X,2(I4,1X),2(F12.8,1X),I1)
END
C== SETMASK ==
SUBROUTINE SETMASK(MASK,IRAS)
C =============================
C
C
C---- Using the raster parameters in array IRAS, this subroutine sets
C up a mask which defines the areas of the peak and the background,
C and the points omitted from peak and background areas.
C
C---- N.B. the mask is required to have MM symmetry.
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Array Arguments ..
INTEGER IRAS(5),MASK(MAXBOX)
C ..
C .. Local Scalars ..
INTEGER HX,HY,IC,IJ,IP,IPQ,IQ,IRX,IRY,P,Q
LOGICAL P1,P2
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
HX = IRAS(1)/2
HY = IRAS(2)/2
C
c---- Test for IRAS(3)=0...code does not work
C
IF (IRAS(3).EQ.0) THEN
WRITE(IOUT,FMT=6000) IRAS
IF (ONLINE) WRITE(ITOUT,FMT=6000) IRAS
6000 FORMAT(1X,'Code in SETMASK will not work if corner parameter',
+ ' of measurement box is zero',/,1X,'Current ',
+ 'measurement box parameters:',5I5)
END IF
C
IC = HX + HY - ABS(IRAS(3))
IRX = HX - IRAS(4)
IRY = HY - IRAS(5)
C
IJ = 0
C
C
DO 20 P = -HX,HX
IP = ABS(P)
P1 = (IP.GT.IRX)
P2 = (IP.EQ.IRX)
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
IQ = ABS(Q)
IPQ = IP + IQ
C
C
IF (P1 .OR. IPQ.GT.IC .OR. IQ.GT.IRY) THEN
C
C
IF (IRAS(3).NE.0 .OR. IP.LT.IRX .OR. IQ.LT.IRY) THEN
C
C
IF (IRAS(3).GE.0 .OR. IPQ.LE.IC) THEN
C
C---- Background points
C
MASK(IJ) = -1
GO TO 10
END IF
END IF
C
C
ELSE IF (.NOT.P2 .AND. IPQ.NE.IC .AND. IQ.NE.IRY) THEN
C
C---- Peak points
C
MASK(IJ) = 1
GO TO 10
END IF
C
C---- Omitted points, now treated as belonging to peak region
C
MASK(IJ) = 1
10 CONTINUE
20 CONTINUE
C
C
END
C== SETMASK2 ==
SUBROUTINE SETMASK2(MASK,IRAS,MASKREJ)
C ======================================
C
IMPLICIT NONE
C
C---- Using the raster parameters in array IRAS, this subroutine sets
C up a mask which defines the areas of the peak and the background,
C and the points omitted from peak and background areas. Differs
C from SETMASK in that it uses a list of rejected backgorund pixels
C suplied in MASKREJ to modify the MASK array. Thus the resulting
C MASK will not necessarily have mm symmetry.
C
C Values in MASK are:
C
C -1 Background pixel
C 0 Rejected background pixel (overlapped by neighbouring spot)
C 1 Peak pixel
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Array Arguments ..
INTEGER IRAS(5),MASK(MAXBOX),MASKREJ(NREJMAX)
C ..
C .. Local Scalars ..
INTEGER HX,HY,IC,IJ,IP,IPQ,IQ,IRX,IRY,P,Q,N,NP,NBREJ
LOGICAL P1,P2
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
C
HX = IRAS(1)/2
HY = IRAS(2)/2
C
c---- Test for IRAS(3)=0...code does not work
C
IF (IRAS(3).EQ.0) THEN
WRITE(IOUT,FMT=6000) IRAS
IF (ONLINE) WRITE(ITOUT,FMT=6000) IRAS
6000 FORMAT(1X,'Code in SETMASK2 will not work if corner parameter',
+ ' of measurement box is zero',/,1X,'Current ',
+ 'measurement box parameters:',5I5)
END IF
IC = HX + HY - ABS(IRAS(3))
IRX = HX - IRAS(4)
IRY = HY - IRAS(5)
C
IJ = 0
C
C
DO 20 P = -HX,HX
IP = ABS(P)
P1 = (IP.GT.IRX)
P2 = (IP.EQ.IRX)
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
IQ = ABS(Q)
IPQ = IP + IQ
C
C
IF (P1 .OR. IPQ.GT.IC .OR. IQ.GT.IRY) THEN
C
C
IF (IRAS(3).NE.0 .OR. IP.LT.IRX .OR. IQ.LT.IRY) THEN
C
C
IF (IRAS(3).GE.0 .OR. IPQ.LE.IC) THEN
C
C---- Background points
C
MASK(IJ) = -1
GO TO 10
END IF
END IF
C
C
ELSE IF (.NOT.P2 .AND. IPQ.NE.IC .AND. IQ.NE.IRY) THEN
C
C---- Peak points
C
MASK(IJ) = 1
GO TO 10
END IF
C
C---- Omitted points, now treated as belonging to peak region
C
MASK(IJ) = 1
10 CONTINUE
20 CONTINUE
C
C---- Now deal with rejected pixels (if any)
C
NBREJ = MASKREJ(1)
IF (NBREJ.EQ.0) RETURN
DO 30 N = 1,NBREJ
NP = MASKREJ(N+1)
MASK(NP) = 0
30 CONTINUE
END
C== SETMAT ==
SUBROUTINE SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C ==========================================
C
IMPLICIT NONE
C
C
C---- Calculate orientation matrix from cell param and U matrix
C if orientation matrix not given. Otherwise calculate cell
C param from the orientation matrix. This code based on Phil's
C code in the A/B scaling pgm PROTIN.
C
C Modified 20/8/93 to allow cell parameters supplied on CELL card to
C overwrite those calculated from AMAT.
C IMAT = 0 AMAT not supplied, derive it from given UMAT and CELL.
C IUMAT and ICELL must be 1 (to indicate they are known)
C
C = 1 AMAT is supplied, derive CELL and UMAT. ICELL will
C normally be 0, but if set to 1, do not reset cell
C parameters in common block with those derived from AMAT,
C and rebuild a new AMAT using the UMAT derived from
C input AMAT and the original cell parameters.
C
C ICHECK =0 Impose symmetry constraints on cell parameters
C =1 Do not impose constraints. This is only done when
C first checking the input cell, so a warning message
C can be given
C = 10 as 0, but do not attempt to scale up the cell for
C a wavelength change
C = 11 as 1, but do not attempt to scale up the cell for
C a wavelength change
C
C .. Scalar Arguments ..
INTEGER ICELL,IMAT,IUMAT,ICHECK
C ..
C .. Local Scalars ..
REAL D,WAVSCAL
INTEGER I,ICHECKL
LOGICAL CELLSCAL
C ..
C .. Local Arrays ..
REAL XMAT(3,3),TCELL(6),TRCELL(6),WORK(3,3)
C ..
C .. External Subroutines ..
EXTERNAL BMATRX,CHECKU,CLCALC,MATMUL3,MINV33,RECCEL,TRANSP,
+ SHUTDOWN,CELLFIX
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C
C
SAVE
C ..
C
C---- See if flag is set NOT to apply wavelenght scaling of cell params.
C
CELLSCAL = .TRUE.
ICHECKL = ICHECK
IF (ICHECKL.GE.10) THEN
ICHECKL = ICHECKL - 10
CELLSCAL = .FALSE.
END IF
C
IF (IMAT.EQ.1) THEN
C
C---- Orientation matrix given explicitly
C
IF (IUMAT.EQ.1) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6000)
WRITE (IOUT,FMT=6000)
END IF
C
CAL IF (ICELL.NE.0) WRITE (ITOUT,FMT=6002)
C
C---- Set WORK to (UB)transpose
C
C *****************
CALL TRANSP(WORK,AMAT)
C *****************
C
C---- Get reciprocal metric tensor G**-1 in GMAT, = (UB)T.(UB)
C
C **********************
CALL MATMUL3(GMAT,WORK,AMAT)
C **********************
C
C---- Get reciprocal cell dimensions TRCELL
C
C ******************
CALL CLCALC(TRCELL,GMAT)
C ******************
C---- Apply symmetry constraints to cell
C
IF ((ICHECKL.EQ.0).AND.(ICELL.EQ.0)) CALL CELLFIX(TRCELL)
C
C---- Invert to get real metric tensor G in WORK
C
C *******************
CALL MINV33(WORK,GMAT,D)
C *******************
C
IF (D.EQ.0.0) THEN
WRITE (IOUT,FMT=6004)
IF (ONLINE) WRITE (ITOUT,FMT=6004)
CALL SHUTDOWN
ELSE
C
C---- Get real cell dimensions from metric tensor
C
C *****************
CALL CLCALC(TCELL,WORK)
C *****************
C
DO 10 I = 1,3
TCELL(I) = TCELL(I)*WAVE
10 CONTINUE
C ******************
C---- Apply symmetry constraints to cell
C
IF ((ICHECKL.EQ.0).AND.(ICELL.EQ.0)) CALL CELLFIX(TCELL)
C
C---- Rebuild cell orthogonalization matrix B in BMAT
C
C ****************************
CALL BMATRX(BMAT,TRCELL,TCELL,WAVE)
C ****************************
C
C---- Get matrix U = (UB).(B**-1) to UMAT
C
C ***********************
CALL MINV33(XMAT,BMAT,D)
CALL MATMUL3(UMAT,AMAT,XMAT)
CALL CHECKU(UMAT)
C ***********************
C
C---- Providing cell parameters calculated from AMAT are not to be
C superceeded by those supplied on CELL card, transfer TCELL, TRCELL
C to CELL,RCELL
C
IF (ICELL.EQ.0) THEN
C
C---- Check this cell against the cell that goes with the U matrix
C in the matrix file. This is in case the orientation matrix was
C determined at a different wavelength.
C
IF ((UMATCELL(1).GT.0.0).AND.CELLSCAL) THEN
IF (ABS(UMATCELL(1) - TCELL(1))/UMATCELL(1).GT.0.001) THEN
WAVSCAL = UMATCELL(1)/TCELL(1)
DO 12 I = 1,3
TCELL(I) = WAVSCAL*TCELL(I)
12 CONTINUE
WRITE(IOUT,FMT=6008) wavSCAL
IF (ONLINE) WRITE(ITOUT,FMT=6008) wavSCAL
6008 FORMAT(1X,'***** WARNING *****',
+ /,1X,'***** WARNING *****',
+ /,1X,'***** WARNING *****',/,1X,
+ 'All cell parameters determined from the A matrix',
+ ' have been scaled up',/,1X,'by',F8.5,'. This is',
+ ' because the cell does not agree with that given',
+ ' in the',/,1X,'matrix file. This will happen if',
+ ' a different wavelength was used in',/,1X,
+ 'determining the orientation matrix (read with',
+ ' the MATRIX keyword) than the',/,1X,
+ 'current wavelength.')
C
C---- To make sure that this only happens once
C
UMATCELL(1) = 0.0
C ***********************
CALL RECCEL(TRCELL,TCELL,WAVE)
C ***********************
C
C---- Get cell orthogonalization matrix B
C
C ****************************
CALL BMATRX(BMAT,TRCELL,TCELL,WAVE)
C ****************************
C
C---- Orientation matrix A = UB
C
C **********************
CALL MATMUL3(AMAT,UMAT,BMAT)
C **********************
C
C---- Set XMAT to (UB)transpose
C
C *****************
CALL TRANSP(XMAT,AMAT)
C *****************
C
C---- Get reciprocal metric tensor G**-1 in GMAT, = (UB)T.(UB)
C
C **********************
CALL MATMUL3(GMAT,XMAT,AMAT)
C **********************
END IF
END IF
DO 20 I = 1,6
CELL(I) = TCELL(I)
RCELL(I) = TRCELL(I)
20 CONTINUE
ELSE
C
C---- Use cell parameters from CELL card to calculate new reciprocal
C cell parameters
C
C---- First check the input cell parameters
C
IF (ICHECKL.EQ.0) CALL CELLFIX(CELL)
C
C
C---- Reset UMATCELL to 0.0, so that it will
C not fall foul of the test just above.
C
DO 22 I = 1,3
UMATCELL(I) = 0.0
22 CONTINUE
C
C ***********************
CALL RECCEL(RCELL,CELL,WAVE)
C ***********************
C ******************
C---- Apply symmetry constraints to cell
C
IF (ICHECKL.EQ.0) CALL CELLFIX(RCELL)
C
C---- Rebuild cell orthogonalization matrix B in BMAT
C
C ****************************
CALL BMATRX(BMAT,RCELL,CELL,WAVE)
C ****************************
C---- Form A = UB
C
C ****************************
CALL MATMUL3(AMAT,UMAT,BMAT)
C ****************************
C
C---- Set WORK to (UB)transpose
C
C *****************
CALL TRANSP(WORK,AMAT)
C *****************
C
C---- Get reciprocal metric tensor G**-1 in GMAT, = (UB)T.(UB)
C
C **********************
CALL MATMUL3(GMAT,WORK,AMAT)
C **********************
C
END IF
END IF
C
C
ELSE
C
C
C---- Orientation matrix AMAT not given explicitly
C
C---- First check that we have sufficient info.
C
IF (ICELL.EQ.0 .OR. IUMAT.EQ.0) THEN
WRITE (IOUT,FMT=6006)
IF (ONLINE) WRITE (ITOUT,FMT=6006)
CALL SHUTDOWN
ELSE
C
C---- Check that UMAT corresponds to a pure rotation matrix
C
C ************
CALL CHECKU(UMAT)
C ************
C
C---- Get reciprocal cell dimensions from real ones - or vica-versa
C
IF (ICELL.EQ.1) THEN
C
C ***********************
CALL RECCEL(RCELL,CELL,WAVE)
C ***********************
C
C---- Apply symmetry constraints to cell
C
IF (ICHECKL.EQ.0) CALL CELLFIX(RCELL)
C
ELSE
C
C ***********************
CALL RECCEL(CELL,RCELL,WAVE)
C ***********************
C
C---- Apply symmetry constraints to cell
C
IF (ICHECKL.EQ.0) CALL CELLFIX(CELL)
C
END IF
C
C---- Get cell orthogonalization matrix B
C
C ****************************
CALL BMATRX(BMAT,RCELL,CELL,WAVE)
C ****************************
C
C---- Orientation matrix A = UB
C
C **********************
CALL MATMUL3(AMAT,UMAT,BMAT)
C **********************
C
C---- Set XMAT to (UB)transpose
C
C *****************
CALL TRANSP(XMAT,AMAT)
C *****************
C
C---- Get reciprocal metric tensor G**-1 in GMAT, = (UB)T.(UB)
C
C **********************
CALL MATMUL3(GMAT,XMAT,AMAT)
C **********************
C
END IF
END IF
C
C---- Format statements
C
6000 FORMAT (/,1X,'U matrix in input ignored as orientation matrix ',
+ 'also given.')
6002 FORMAT (/,1X,'Cell parameters ignored - they will be calculated',
+ ' from the orientation matrix A.')
6004 FORMAT (//,1X,'!!! Zero reciprocal cell volume from orientation',
+ ' matrix !!!',//)
6006 FORMAT (//,1X,'***** FATAL ERROR *****',/,1X,
+ 'Either the orientation matrix A (MATRIX keyword)',
+ ' or both the cell ',/,1X,
+ 'parameters and the U matrix (UMATRIX keyword) must be',
+ ' specified')
C
C
END
C== SETSM2 ==
SUBROUTINE SETSM2(MASK,IRAS,PQVAL,PQSUMS,PQSUMINV)
C ==================================================
C
IMPLICIT NONE
C
C
C---- This routine calculates background sums used in determination of
C the background plane. It differs from SETSUMS in that this allows
C for rejected background pixels in the array MASK, so it calculates
C PQSUMS and its inverse rather than just PQVAL.
C
C
C Elements of PQSUMS
C p,q are pixel coords wrt centre of box, all sums are for background
C points ONLY. Note that these sums are updated for every spot based
C on rejected background pixels (done in BGTEST)
C 1 = sum p*p
C 2 = sum q*q
C 3 = sum p*q
C 4 = sum p
C 5 = sum q
C 6 = number of background pixels
C
C
C Elements of PQVAL
C p,q are pixel coords wrt centre of box
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C .. Array Arguments ..
REAL PQVAL(6),PQSUMS(6),PQSUMINV(9)
INTEGER IRAS(5),MASK(MAXBOX)
C ..
C .. Local Scalars ..
REAL PP,QQ,SPP,SQQ,TPP,TQQ,SP,SQ,SPQ
INTEGER IJ,S,T,P,Q,IHX,IHY
C ..
C ..
C .. External Subroutines ..
EXTERNAL PQINV
C
C
IHX = IRAS(1)/2
IHY = IRAS(2)/2
C
T = 0
S = 0
TPP = 0.0
SPP = 0.0
TQQ = 0.0
SQQ = 0.0
SP = 0.0
SQ = 0.0
SPQ = 0.0
IJ = 0
C
C
DO 40 P = -IHX,IHX
PP = P*P
C
C
DO 30 Q = -IHY,IHY
IJ = IJ + 1
C
C
IF ((MASK(IJ)).EQ.0) THEN
GO TO 30
ELSE IF ((MASK(IJ)).GT.0) THEN
GO TO 20
END IF
C
C---- Sums for the background
C
10 S = S + 1
QQ = Q*Q
SP = P + SP
SQ = Q + SQ
SPP = SPP + PP
SQQ = SQQ + QQ
SPQ = SPQ + P*Q
GO TO 30
C
C---- Sums for the peak
C
20 T = T + 1
QQ = Q*Q
TPP = TPP + PP
TQQ = TQQ + QQ
30 CONTINUE
40 CONTINUE
C
C
PQVAL(1) = TPP
PQVAL(2) = SPP
PQVAL(3) = TQQ
PQVAL(4) = SQQ
PQVAL(5) = T
PQVAL(6) = S
C
PQSUMS(1) = SPP
PQSUMS(2) = SQQ
PQSUMS(3) = SPQ
PQSUMS(4) = SP
PQSUMS(5) = SQ
PQSUMS(6) = S
C
C
C ****************************
CALL PQINV(PQSUMS(1),PQSUMINV(1))
C ****************************
END
C== SETSUMS ==
SUBROUTINE SETSUMS(MASK,IRAS,PQVAL)
C ===================================
C
IMPLICIT NONE
C
C---- Latest revision- 1 june 1979
C
C---- Called by PROCESS
C
C---- This routine calculates sums used in the routine integ
C
C Elements of PQVAL
C p,q are pixel coords wrt centre of box
C 1 = sum p*p for peak
C 2 = sum p*p for background
C 3 = sum q*q for peak
C 4 = sum q*q for background
C 5 = number of peak pixels
C 6 = number of background pixels
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Array Arguments ..
REAL PQVAL(6)
INTEGER IRAS(5),MASK(MAXBOX)
C ..
C .. Local Scalars ..
REAL PP,QQ,SPP,SQQ,TPP,TQQ
INTEGER IJ,S,T,P,Q,IHX,IHY
C ..
C
C
IHX = IRAS(1)/2
IHY = IRAS(2)/2
C
T = 0
S = 0
TPP = 0.0
SPP = 0.0
TQQ = 0.0
SQQ = 0.0
IJ = 0
C
C
DO 40 P = -IHX,IHX
PP = P*P
C
C
DO 30 Q = -IHY,IHY
IJ = IJ + 1
C
C
IF ((MASK(IJ)).EQ.0) THEN
GO TO 30
ELSE IF ((MASK(IJ)).GT.0) THEN
GO TO 20
END IF
C
C---- Sums for the background
C
10 S = S + 1
QQ = Q*Q
SPP = SPP + PP
SQQ = SQQ + QQ
GO TO 30
C
C---- Sums for the peak
C
20 T = T + 1
QQ = Q*Q
TPP = TPP + PP
TQQ = TQQ + QQ
30 CONTINUE
40 CONTINUE
C
C
PQVAL(1) = TPP
PQVAL(2) = SPP
PQVAL(3) = TQQ
PQVAL(4) = SQQ
PQVAL(5) = T
PQVAL(6) = S
C
C
END
c
c---- Routine to compress normal matrix Q & gradient vector S to remove
c any parameters which have no contributions (nrfc(i) = 0); these
C always come in pairs
C
SUBROUTINE SHRINK(Q,S,NNP,FPNT,NC,IC,NOREFCELL)
C
C Q is the normal matrix stored as a 1D array of size (NNP*NNP)
C S is the shift vector size NNP
C NC is the number of refined unit cell parameters
C IC is the refinement cycle number
C
C DEBUG(69) this routine; keyword DEBUG SHRINK
C
C
C---- Array arguments
C
REAL Q(NNP*NNP),S(NNP),FPNT(NNP)
C
C---- Scalar arguments
C
INTEGER NNP,NC,IC
LOGICAL NOREFCELL
C
C---- Local scalars
C
INTEGER I,II,J,IJ,NCELL,ISTART,ITEMP,NNPOLD,NNQ
C
C---- Local arrays
C
PARAMETER (NNQ=100)
REAL Q1(NNQ,NNQ)
C
C---- include files
C
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C
NNPOLD = NNP
IF (DEBUG(69)) THEN
WRITE(IOUT,FMT=1020)
IF (ONLINE) WRITE(ITOUT,FMT=1020)
ENDIF
C
C---- initialize Q1
C
DO 5 I=1,NNQ,1
DO 4 J=1,NNQ,1
Q1(I,J) = 0.0
4 ENDDO
5 ENDDO
C
C---- copy Q into a 2d matrix because chopping rows and columns is easier
C
DO 20 I=1,NNP,1
DO 10 J=1,NNP,1
Q1(I,J) = Q((I-1)*NNP+J)
10 ENDDO
20 ENDDO
ITEMP = 0
IF ((IC.GT.1).AND..NOT.(NOREFCELL))THEN
NCELL = NC
ELSE
NCELL = 0
ENDIF
ISTART = 3 + NCELL
C
C---- output initial matrix
C
IF (DEBUG(69)) THEN
WRITE(IOUT,FMT=1050)
IF (ONLINE) WRITE(ITOUT,FMT=1050)
WRITE(IOUT,FMT=1000) (S(I),I=1,NNP)
IF (ONLINE) WRITE(ITOUT,FMT=1000) (S(I),I=1,NNP)
WRITE(IOUT,FMT=1010) IC,NS,NNP,ITEMP,NCELL,ISTART,IJ,
$ (Q(IJ),IJ=1,NNP*NNP)
IF (ONLINE) WRITE(ITOUT,FMT=1010) IC,NS,NNP,ITEMP,NCELL
$ ,ISTART,IJ,(Q(IJ),IJ=1,NNP*NNP)
ENDIF
DO 70 IJ = ISTART,NNP-1,2
I = IJ + ITEMP
C
C---- copy current value to pointer array
C
FPNT(IJ) = Q1(IJ,IJ)
FPNT(IJ+1) = Q1(IJ+1,IJ+1)
IF ((Q1(I,I).EQ.0.0).AND.(Q1(I+1,I+1).EQ.0.0))THEN
C
C---- COPY ROWS & values for S()
C
DO 40 II=I,NNP-2
S(II)=S(II+2)
DO 30 J=1,NNP,1
Q1(II,J)=Q1(II+2,J)
30 ENDDO
40 ENDDO
C
C---- copy columns
C
DO 60 II=I,NNP-2
DO 50 J=1,NNP,1
Q1(J,II)=Q1(J,II+2)
50 ENDDO
60 ENDDO
C
C---- shrink dimension of array
C
ITEMP = ITEMP - 2
ENDIF
70 ENDDO
NNP = NNP+ITEMP
C
C---- copy back to 1D Array
C
DO 90 I=1,NNP,1
DO 80 J=1,NNP,1
Q((I-1)*NNP+J) = Q1(I,J)
80 ENDDO
90 ENDDO
C
C---- output shrunk matrix
C
IF (DEBUG(69)) THEN
IF (NNP.EQ.NNPOLD)THEN
WRITE(IOUT,FMT=1070)
IF (ONLINE) WRITE(ITOUT,FMT=1070)
ELSE
WRITE(IOUT,FMT=1060)
IF (ONLINE) WRITE(ITOUT,FMT=1060)
WRITE(IOUT,FMT=1000) (S(I),I=1,NNP)
IF (ONLINE) WRITE(ITOUT,FMT=1000) (S(I),I=1,NNP)
WRITE(IOUT,FMT=1010) IC,NS,NNP,ITEMP,NCELL,ISTART,IJ,
$ (Q(IJ),IJ=1,NNP*NNP)
IF (ONLINE) WRITE(ITOUT,FMT=1010) IC,NS,NNP,ITEMP,NCELL
$ ,ISTART,IJ,(Q(IJ),IJ=1,NNP*NNP)
WRITE(IOUT,FMT=1030)
IF (ONLINE) WRITE(ITOUT,FMT=1030)
ENDIF
ENDIF
RETURN
C
C---- FORMAT STATEMENTS
C
1000 FORMAT(/1X,'RHS VECTOR',/,(1X,8E10.3))
1010 FORMAT(//1X,'PASS',I3,' NS=',I3,' NNP=',I3,' ITEMP= ',I3,
$ ' NCELL= ',I3, ' ISTART= ',I3,' IJ= ',
$ I3,/,1X,'Normal matrix',/,
$ (1X,8E10.3,/))
1020 FORMAT(73('*'),/,24('*'),' Shrinking Normal Matrix ',24('*'),/)
1030 FORMAT(/,20('='),' Normal matrix shrinking finished ',19('='),/,
$ 73('='))
1050 FORMAT(/,'Initial values:',/)
1060 FORMAT(/,'Final values:',/)
1070 FORMAT(/,14('-'),' Matrix not shrunk - no null columns',
$ ' or rows ',14('-'),/,73('-'))
END
C== SHUTDOWN ==
SUBROUTINE SHUTDOWN
C
IMPLICIT NONE
C
C---- Close the mtz file, print warning messages and stop
C
C
C Common block PARAMETER
C .. Include files ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER MTZPRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C
CALL WARNINGS
CALL GROUT
C
IF (MTZOPEN) THEN
MTZPRT = 1
C *********************
CALL LWCLOS(MTZOUT,MTZPRT)
C *********************
MTZOPEN = .FALSE.
END IF
C
STOP
END
C== SIZRAS ==
C
C
C
SUBROUTINE SIZRAS(IRAS,NPEAK,NBG)
C =================================
C
C
C
C
C .. Scalar Arguments ..
INTEGER NBG,NPEAK
C ..
C .. Array Arguments ..
INTEGER IRAS(5)
C ..
C .. Local Scalars ..
INTEGER IC,IHX,IHY,IP,IPQ,IQ,IRX,IRY,NMISS,P,Q
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C
C
IHX = IRAS(1)/2
IHY = IRAS(2)/2
IC = IHX + IHY - IRAS(3)
IRX = IHX - IRAS(4)
IRY = IHY - IRAS(5)
NPEAK = 0
NBG = 0
NMISS = 0
C
C
DO 20 P = -IHX,IHX
IP = ABS(P)
C
C
DO 10 Q = -IHY,IHY
IQ = ABS(Q)
IPQ = IP + IQ
C
C
IF ((IPQ.GT.IC) .OR. (IP.GT.IRX) .OR. (IQ.GT.IRY)) THEN
NBG = NBG + 1
ELSE IF ((IPQ.LT.IC) .AND. (IP.LT.IRX) .AND. (IQ.LT.IRY)) THEN
NPEAK = NPEAK + 1
ELSE
NMISS = NMISS + 1
END IF
C
C
10 CONTINUE
20 CONTINUE
C
C
END
SUBROUTINE SKIPIMG(INMO)
C
C---- Skip a set of measurement boxes for one complete image. Needed when
C postrefinement results in more than one set of boxes being written
C for the same image (if measurement repeated due to large shift)
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER INMO
C ..
C .. Local Scalars ..
INTEGER NREF,MAXR,NPARTEND
REAL XCEN,YCEN
C ..
C .. Local Arrays ..
INTEGER*2 IIBUF(4),ODBOX(MAXBOX)
C ..
C .. External Subroutines ..
EXTERNAL PREAD
C
C
READ (INMO) XCEN,YCEN,NREF,MAXR,NPARTEND
DO 10 I = 1,NREF
READ (INMO) LEN,IIBUF
C ************************
CALL PREAD(ODBOX(1),LEN,INMO)
C ************************
10 CONTINUE
RETURN
END
SUBROUTINE SORTPART(COUNTJ,FXYHKL,IXYHKL,FPARTS,IPARTS)
IMPLICIT NONE
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/modarray.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C bits that should only be accessed in modarray.f
C
C IPARTS = array for the integer parts(Image number, MPART)
C IXYHKL = array to hold the indices (H, K, L)
C FPARTS = array to hold the real parts (I, SIGMAI, FRcalc)
C FXYHKL = array to hold the film co-ordinates in mm & PHIW (X, Y, PHI and
C PHIwidth)
INTEGER IPARTS(4,MGRA,NGRA),IXYHKL(3,MGRA)
REAL FPARTS(MGRA,NGRA),FXYHKL(5,MGRA)
INTEGER IBIG,JBIG,KBIG
INTEGER IXBIG(MGRA),IYBIG(MGRA),IRECBIG(MGRA),NREFBIG
REAL INTENS,SIGINT,FRCALC,PHIWID
INTEGER ITEMP,JTEMP,KTEMP
C&&*&& end_include ../inc/modarray.f
integer i,j,k,COUNTJ
INTEGER iwksp(MGRA),iiwksp(MGRA)
INTEGER HKANDL(MGRA)
REAL wksp(MGRA)
C USES indexx
C
C First we combine the H,K and L so that we can sort in one step;
C this should pretty well sort on H first, then K and then L
C
DO 10 J=1,COUNTJ,1
HKANDL(J) = 1000*(IXYHKL(1,J)*1000+IXYHKL(2,J))+
$ IXYHKL(3,J)
c if(j.le.20)print*,IXYHKL(1,J),IXYHKL(2,J),IXYHKL(3,J),HKANDL(J)
10 CONTINUE
call sortup4(COUNTJ,HKANDL,iwksp)
C
C sorting X and Y coordinate, Phi, phi width and background ratio fields
C
DO 120 I=1,5,1
DO 110 J=1,COUNTJ
WKSP(J)=FXYHKL(I,J)
110 CONTINUE
DO 115 J=1,COUNTJ
FXYHKL(I,J)=WKSP(IWKSP(J))
115 CONTINUE
120 CONTINUE
C
C sorting H,K,L fields
C
do 140 i=1,3,1
do 130 j=1,COUNTJ
iiwksp(j)=ixyhkl(i,j)
130 continue
do 135 j=1,COUNTJ
ixyhkl(i,j)=iiwksp(iwksp(j))
135 continue
140 continue
C
C sorting the intensity, sigma(I), partiality fields
C
chrp02071999 do 170 i=1,3,1
DO 160 j=1,NGRA,1
do 150 k=1,COUNTJ
wksp(k)=FPARTS(k,j)
150 CONTINUE
do 155 k=1,COUNTJ
FPARTS(k,j)=wksp(iwksp(k))
155 CONTINUE
160 CONTINUE
chrp02071999 170 continue
C
C sorting MPART and image number fields
C
DO 200 I=1,4,1
DO 190 J=1,NGRA,1
DO 180 K=1,COUNTJ
IIWKSP(K)=IPARTS(I,K,J)
180 CONTINUE
DO 185 K=1,COUNTJ
IPARTS(I,K,J)=IIWKSP(IWKSP(K))
185 CONTINUE
190 CONTINUE
200 CONTINUE
RETURN
END
C== SORTUP ==
C
C
C
SUBROUTINE SORTUP2(N,A,IN)
C ========================
C
C---- Ref: Comm. ACM VOL.12 #3 MARCH 1969, R.C.SINGLETON
C
C---- Routine returns order of A in IN
C
C
C
C
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Array Arguments ..
INTEGER*2 A(N),IN(N)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,L,M
INTEGER*2 T,TT
C ..
C .. Local Arrays ..
INTEGER*2 IL(16),IU(16)
C ..
C
C
DO 10 I = 1,N
IN(I) = I
10 CONTINUE
C
C
M = 1
I = 1
J = N
C
20 IF (I.GE.J) GO TO 80
30 K = I
IJ = (I+J)/2
T = IN(IJ)
C
C
IF (A(IN(I)).GT.A(T)) THEN
IN(IJ) = IN(I)
IN(I) = T
T = IN(IJ)
END IF
C
C
L = J
IF (A(IN(J)).GE.A(T)) GO TO 50
C
C
IF (A(IN(J)).GE.A(IN(I))) THEN
IN(IJ) = IN(J)
IN(J) = T
T = IN(IJ)
GO TO 50
END IF
C
IN(IJ) = IN(I)
IN(I) = IN(J)
IN(J) = T
T = IN(IJ)
GO TO 50
C
40 IN(L) = IN(K)
IN(K) = TT
50 L = L - 1
IF (A(IN(L)).GT.A(T)) GO TO 50
TT = IN(L)
60 K = K + 1
IF (A(IN(K)).LT.A(T)) GO TO 60
IF (K.LE.L) GO TO 40
IF ((L-I).LE. (J-K)) GO TO 70
IL(M) = I
IU(M) = L
I = K
M = M + 1
GO TO 90
70 IL(M) = K
IU(M) = J
J = L
M = M + 1
GO TO 90
C
80 M = M - 1
IF (M.EQ.0) RETURN
I = IL(M)
J = IU(M)
90 IF ((J-I).GE.11) GO TO 30
IF (I.EQ.1) GO TO 20
I = I - 1
100 I = I + 1
IF (I.EQ.J) GO TO 80
T = IN(I+1)
IF (A(IN(I)).LE.A(T)) GO TO 100
K = I
110 IN(K+1) = IN(K)
K = K - 1
IF (A(T).LT.A(IN(K))) GO TO 110
IN(K+1) = T
GO TO 100
C
C
C
END
C== SORTUP3 ==
SUBROUTINE SORTUP3(N,A,B,C)
C ===========================
C
C
C---- COMM.ACM VOL.12 #3 MARCH 1969, R.C.SINGLETON
C
C---- Note well
C Arrays to be sorted are integer*4 (changed 2/9/94)
C
C
C
C
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Array Arguments ..
INTEGER*4 A(N),B(N),C(N)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,L,M
INTEGER*4 T,TT,X,Y
C ..
C .. Local Arrays ..
INTEGER IL(16),IU(16)
C ..
C
C
M = 1
I = 1
J = N
10 CONTINUE
IF (I.GE.J) GO TO 90
20 K = I
IJ = (I+J)/2
T = A(IJ)
C
C
IF (A(I).GT.T) THEN
A(IJ) = A(I)
A(I) = T
T = A(IJ)
X = B(I)
B(I) = B(IJ)
B(IJ) = X
Y = C(I)
C(I) = C(IJ)
C(IJ) = Y
END IF
C
C
L = J
IF (A(J).GE.T) GO TO 60
C
C
IF (A(J).GE.A(I)) THEN
A(IJ) = A(J)
A(J) = T
T = A(IJ)
X = B(IJ)
B(IJ) = B(J)
B(J) = X
Y = C(IJ)
C(IJ) = C(J)
C(J) = Y
GO TO 60
END IF
C
C
A(IJ) = A(I)
A(I) = A(J)
A(J) = T
T = A(IJ)
X = B(J)
B(J) = B(IJ)
B(IJ) = B(I)
B(I) = X
Y = C(J)
C(J) = C(IJ)
C(IJ) = C(I)
C(I) = Y
GO TO 60
50 A(L) = A(K)
A(K) = TT
X = B(L)
B(L) = B(K)
B(K) = X
Y = C(L)
C(L) = C(K)
C(K) = Y
60 L = L - 1
IF (A(L).GT.T) GO TO 60
TT = A(L)
70 K = K + 1
IF (A(K).LT.T) GO TO 70
IF (K.LE.L) GO TO 50
C
C
IF ((L-I).GT. (J-K)) THEN
IL(M) = I
IU(M) = L
I = K
M = M + 1
GO TO 100
END IF
C
C
IL(M) = K
IU(M) = J
J = L
M = M + 1
GO TO 100
90 M = M - 1
IF (M.EQ.0) RETURN
I = IL(M)
J = IU(M)
100 CONTINUE
IF ((J-I).GE.11) GO TO 20
IF (I.EQ.1) GO TO 10
I = I - 1
110 I = I + 1
IF (I.EQ.J) GO TO 90
T = A(I+1)
IF (A(I).LE.T) GO TO 110
X = B(I+1)
Y = C(I+1)
K = I
120 A(K+1) = A(K)
B(K+1) = B(K)
C(K+1) = C(K)
K = K - 1
IF (T.LT.A(K)) GO TO 120
A(K+1) = T
B(K+1) = X
C(K+1) = Y
GO TO 110
END
C== SORTUP4 ==
SUBROUTINE SORTUP4(N,A,IN)
C ========================
C This is identical to SORTUP except that both arrays are I*4 rather than
C I*2.
C
C---- Ref: Comm. ACM VOL.12 #3 MARCH 1969, R.C.SINGLETON
C
C---- Routine returns order of A in IN
C
C
C
C
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Array Arguments ..
INTEGER A(N),IN(N)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,L,M,T,TT
C ..
C .. Local Arrays ..
INTEGER IL(16),IU(16)
C ..
C
C
DO 10 I = 1,N
IN(I) = I
10 CONTINUE
C
C
M = 1
I = 1
J = N
C
20 IF (I.GE.J) GO TO 80
30 K = I
IJ = (I+J)/2
T = IN(IJ)
C
C
IF (A(IN(I)).GT.A(T)) THEN
IN(IJ) = IN(I)
IN(I) = T
T = IN(IJ)
END IF
C
C
L = J
IF (A(IN(J)).GE.A(T)) GO TO 50
C
C
IF (A(IN(J)).GE.A(IN(I))) THEN
IN(IJ) = IN(J)
IN(J) = T
T = IN(IJ)
GO TO 50
END IF
C
IN(IJ) = IN(I)
IN(I) = IN(J)
IN(J) = T
T = IN(IJ)
GO TO 50
C
40 IN(L) = IN(K)
IN(K) = TT
50 L = L - 1
IF (A(IN(L)).GT.A(T)) GO TO 50
TT = IN(L)
60 K = K + 1
IF (A(IN(K)).LT.A(T)) GO TO 60
IF (K.LE.L) GO TO 40
IF ((L-I).LE. (J-K)) GO TO 70
IL(M) = I
IU(M) = L
I = K
M = M + 1
GO TO 90
70 IL(M) = K
IU(M) = J
J = L
M = M + 1
GO TO 90
C
80 M = M - 1
IF (M.EQ.0) RETURN
I = IL(M)
J = IU(M)
90 IF ((J-I).GE.11) GO TO 30
IF (I.EQ.1) GO TO 20
I = I - 1
100 I = I + 1
IF (I.EQ.J) GO TO 80
T = IN(I+1)
IF (A(IN(I)).LE.A(T)) GO TO 100
K = I
110 IN(K+1) = IN(K)
K = K - 1
IF (A(T).LT.A(IN(K))) GO TO 110
IN(K+1) = T
GO TO 100
C
C
C
END
C== SORTUP5 ==
SUBROUTINE SORTUP5(N,A,IN)
C ========================
C This is identical to SORTUP4 except that array to be sorted is real
C
C---- Ref: Comm. ACM VOL.12 #3 MARCH 1969, R.C.SINGLETON
C
C---- Routine returns order of A in IN
C
C
C
C
C .. Scalar Arguments ..
INTEGER N
C ..
C .. Array Arguments ..
REAL A(N)
INTEGER IN(N)
C ..
C .. Local Scalars ..
INTEGER I,IJ,J,K,L,M,T,TT
C ..
C .. Local Arrays ..
INTEGER IL(16),IU(16)
C ..
C
C
DO 10 I = 1,N
IN(I) = I
10 CONTINUE
C
C
M = 1
I = 1
J = N
C
20 IF (I.GE.J) GO TO 80
30 K = I
IJ = (I+J)/2
T = IN(IJ)
C
C
IF (A(IN(I)).GT.A(T)) THEN
IN(IJ) = IN(I)
IN(I) = T
T = IN(IJ)
END IF
C
C
L = J
IF (A(IN(J)).GE.A(T)) GO TO 50
C
C
IF (A(IN(J)).GE.A(IN(I))) THEN
IN(IJ) = IN(J)
IN(J) = T
T = IN(IJ)
GO TO 50
END IF
C
IN(IJ) = IN(I)
IN(I) = IN(J)
IN(J) = T
T = IN(IJ)
GO TO 50
C
40 IN(L) = IN(K)
IN(K) = TT
50 L = L - 1
IF (A(IN(L)).GT.A(T)) GO TO 50
TT = IN(L)
60 K = K + 1
IF (A(IN(K)).LT.A(T)) GO TO 60
IF (K.LE.L) GO TO 40
IF ((L-I).LE. (J-K)) GO TO 70
IL(M) = I
IU(M) = L
I = K
M = M + 1
GO TO 90
70 IL(M) = K
IU(M) = J
J = L
M = M + 1
GO TO 90
C
80 M = M - 1
IF (M.EQ.0) RETURN
I = IL(M)
J = IU(M)
90 IF ((J-I).GE.11) GO TO 30
IF (I.EQ.1) GO TO 20
I = I - 1
100 I = I + 1
IF (I.EQ.J) GO TO 80
T = IN(I+1)
IF (A(IN(I)).LE.A(T)) GO TO 100
K = I
110 IN(K+1) = IN(K)
K = K - 1
IF (A(T).LT.A(IN(K))) GO TO 110
IN(K+1) = T
GO TO 100
C
C
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== SPROCESS ==
SUBROUTINE SPROCESS(LEN,IBUFF,SUMPART,POSTREF,NEWPREF)
C ======================================================
C
IMPLICIT NONE
C
C
C---- This subroutine processes the measurement boxes for each spot
C as soon as all the pixels have been accumulated in subroutine MEAS.
C Pixel values are passed in array BOXOD in /PEL/, and extracted by calling
C CBYTE2, which transfers byte od to I*4 variable IBA in the case of
C film data, and I*2 words to IBA for image plate data.
C It thus avoids writing and reading the file MOSFLM.OUT
C however the array "MASK" can no longer be equivalenced to IDUM.
C
C Notice that SUMPART is not actually required for this subroutine itself
C but has to be passed in call to WRGEN
C
C******DEBUG(49) FOR THIS SUBROUTINE ******
C
C---- LEN is used as a flag
C = -1 for estimation of resolution from intensities in bins.
C =0 First call to SPROCESS to initialise parameters
C =1 Final call to print statistics
C Otherwise...
C = Length of od buffer =0.5*(number of pixels in spot) for film data
C =(number of pixels in spot) for image plates
C
C
C
C IBUFF (passed from meas) contains:
C 1 Record number
C 2 X coordinate
C 3 Y coordinate
C 4 NXX box size in X
C 5 NYY box size in Y
C 6 Profile box number
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER LEN
LOGICAL SUMPART,POSTREF,NEWPREF
C ..
C .. Array Arguments ..
INTEGER IBUFF(6)
C ..
C .. Local Scalars ..
REAL BASE,BGDEVMAX,BGND,BGRATIO,BGRMS,BOXFAC,CFAC,DELX,
+ DELY,PI,RMSBG,SCAI,SOD,TBGND,TPEAK,
+ TRUOD,VBG,VSPOT,WPX,WPY,XX,YY,XC,YC,XCG,YCG,A,B,C,
+ RESID,RETA,RDIVH,RDIVV,PKRATIOS,VARTOT,GRADM,DSTSQ
INTEGER I,IBGND,IDR,II,IMAP,IRECG,ISDBSI,ISPOT,IXPIX,
+ IXX,IYPIX,IYY,J,JREC,JUNK,K,KREC,MODEWR,N,NBOXES,NC,NY,
+ NRX,NRY,NSPT,NXS,NXX,NXY,NYS,NYY,IFAIL,NREJ,NRFL,
+ NCOUNT,IOVER,ISPOTPRO,ISIGPRO,NSBOX,IPART,ITHBIN,
+ NBADBG,NPBOX,ISTRIP,ISTRIPCUR,NFBOX,MAXPIX,NBIN1,ISTAT,
+ IMODE,LASTREC,NNN,KHF
LOGICAL FULL,LDUMP,YES,PROFILEDUM,USEOVRLDDUM,OVRLFITDUM,
+ FIXEDDUM,BADFLAG
C ..
C .. Local Arrays ..
REAL SUMPQ(6,1:NNLINE-1),XSH(16),YSH(16),PQSUMS(6)
INTEGER IH(7),IHD(3,50),LRAS(5),MASK(MAXBOX,1:NNLINE-1),
+ NSH(16),OD(MAXBOX),TABLE(0:255),MASKREJ(NREJMAX)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL CBYTE2,COMPR,GETHKL,
+ INTEG,PWRGEN,RASPLOT,REPORT,
+ SETMASK,SETSUMS,WRGEN,XYSHIFT,YESNO,POSTREFL,
+ ODPLOT4,GETYIND,GETSTRIP,GETBIN,MMTOPX,SHUTDOWN
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,AMAX0,ATAN,COS,MAX,MIN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/amatch.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file amatch.h
C---- START of include file amatch.h
C
C
C .. Scalars in Common /AMATCH/ ..
C ..
REAL RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT
INTEGER NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,N8,N9,N10,NBEAM
LOGICAL MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C .. Common block /AMATCH/ ..
COMMON /AMATCH/RCONV,OVRLAP,RESOL1,RESOL2,AELIMIT,ARMSLIM,
+ SECANGLE,DAMP,TRUECCOM,ETAMAX,AWRMSLIM,MOSNEW,
$ SLOPE,INTERCEPT,NSTEP,NCYCA,NPASS,N2,N3,N4,N5,N6,N7,
$ N8,N9,N10,NBEAM,MATCH,NOCENT,NOREFINE,RMOSAIC
C ..
C
C
C&&*&& end_include ../inc/amatch.f
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/comarray.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C Common bits for the big array handling for post refinement
C
C---- for passing the summed partials around different routines
C
INTEGER INTPOST(2),SIGPOST(2)
C
C---- COMMON BLOCK POSTPHI
C
REAL PHIPOST
COMMON /POSTPHI/ PHIPOST
C
C---- COMMON block /SUMPARTS/
C
INTEGER JCOUNT
COMMON /SUMPARTS/ JCOUNT
C
C---- COMMON block /IMAGENO/
C
INTEGER IMAGE_NUMBER
COMMON /IMAGENO/ IMAGE_NUMBER
C&&*&& end_include ../inc/comarray.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/film_no.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
integer id
common /film_num/ id
C&&*&& end_include ../inc/film_no.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/precession.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file precession.h
C---- START of include file precession.h
C
C
C .. Scalars in common block /PRECESSION/ ..
REAL D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA
LOGICAL PRECESS
C ..
C .. Common Block /PRECESSION/ ..
COMMON /PRECESSION/D1,D2,PHIPREC,PSIPREC,PCTOFD,XLAMBDA,PRECESS
C ..
C
C
C&&*&& end_include ../inc/precession.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reflist.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reflist.h
C---- START of include file reflist.h
C
C
C .. Arrays in common block /REFLIST/ ..
INTEGER XREF,YREF,INTREF,ISDREF
C ..
C .. Common Block /REFLIST/ ..
COMMON /REFLIST/XREF(NREFLS),YREF(NREFLS),INTREF(NREFLS),
+ ISDREF(NREFLS)
C ..
C
C
C&&*&& end_include ../inc/reflist.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/resest.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- Start of include file resest.h
LOGICAL RESEST
COMMON/ESTIMATOR/RESEST
C&&*&& end_include ../inc/resest.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C
COMMON /XYSCAN/ IXPIX,IYPIX
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (LRAS(1),NXX), (LRAS(2),NYY)
EQUIVALENCE (ASPOT(1),SOD), (ASPOT(2),BGND), (ASPOT(3),RMSBG)
EQUIVALENCE (ASPOT(4),DELX), (ASPOT(5),DELY),(ASPOT(9),A)
EQUIVALENCE (ASPOT(10),B), (ASPOT(11),C), (ASPOT(12),BGDEVMAX)
C ..
SAVE
C ..
C
C .. Data statements ..
C
C---- These variables are required for consistency in calls to WRGEN
C and REPORT from subroutine PROCESS, although they must both be
C FALSE when not using profile fitting.
C
DATA PROFILEDUM/.FALSE./,USEOVRLDDUM/.FALSE./,NCOUNT/0/,
+ OVRLFITDUM/.FALSE./,ISPOTPRO/0/,ISIGPRO/0/,PKRATIOS/0.0/,
+ NSBOX/0/,FIXEDDUM/.FALSE./
C
NBIN1 = 8
NRFL = 1
MAXPIX = 0
NNN = 1
C *******************************************************************
C---- Initialise arrays and variables
C *******************************************************************
IF (LEN.EQ.0) THEN
IF (BRIEF.AND.(.NOT.POSTREF)) WRITE(IBRIEF,FMT=6000)
IF (ONLINE.AND.(.NOT.POSTREF)) WRITE (ITOUT,FMT=6000)
6000 FORMAT (1X,'Integrating reflections')
IF (DEBUG(49)) THEN
WRITE(IOUT,FMT=6001)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
END IF
6001 FORMAT(1X,'Initialising variables in SPROCESS')
C
C---- IDR gives direction of scanning, +1 for left to right.
C
IDR = 1
C
IF (.NOT.IMGP) THEN
C
C---- Generate look-up table
C
CFAC = CURV/N1OD
BASE = BASEOD*N1OD
C
C
DO 140 I = 0,255
TRUOD = I - BASE
TABLE(I) = (CFAC*TRUOD+1.0)*TRUOD + 0.5
TABLE(I) = AMAX0(0,TABLE(I))
140 CONTINUE
C
END IF
C
C
C---- Determine scale factor for intensities
C
C **********************************
CALL SETMASK(MASK(1,1),IRAS)
CALL SETSUMS(MASK(1,1),IRAS,SUMPQ(1,1))
C **********************************
C
SCAI = 2.0*FLOAT(ISCAL)/SUMPQ(5,1)
C
C
C---- IOVER is flag for overloaded reflections, 9999 for film,
C 999999 for IP.
C
IOVER = 9999
C
C---- For IP, make scale factor unity and change values in IRANGE
C
IF (IMGP) THEN
IOVER = 999999
SCAI = 1.0
IRANGE(1) = -750
IRANGE(2) = 0
DO 11 I = 3,9
IRANGE(I) = 1250*2**(I-3)
11 CONTINUE
END IF
C
C
C---- Set up resolution bins
C
IRECG = 0
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
C
DO 180 I = 3,5
LRAS(I) = IRAS(I)
C
C---- Increase the rim and corner cutoff by 1 for post refinement
C as this gives a "cleaner" signal and copes better with cases where
C the slippage is large. Check that this still leaves at least 3
C pixels in peak
IF (POSTREF) THEN
IF ((I.EQ.3).OR.
+ ((I.EQ.4).AND.((NXS - 2*NRX).GE.5)).OR.
+ ((I.EQ.5).AND.((NYS - 2*NRY).GE.5))) THEN
LRAS(I) = LRAS(I) + 1
END IF
END IF
180 CONTINUE
C
C---- Calculate BOXFAC, used in calculation of contribution to spot
C intensity variance due to scanner instrument errors
C
WPX = IRAS(1) - (IRAS(4)+1)*2
WPY = IRAS(2) - (IRAS(5)+1)*2
BOXFAC = (((WPX+1)/ (WPY+1))**2)* (WPY**2*3.0+WPY**3+5*WPY+3)/
+ 12.0
C
ISTRIPCUR = 0
J = 0
PI = ATAN(1.0)*4.0
C
C---- Do not initialise arrays if only calling SPROCESS for postrefinement
C
IF (POSTREF) RETURN
C
C---- Only open file for BADSPOTS if running online
C
IFAIL = 1
C
C *************************************
IF (ONLINE.AND.(.NOT.MATCH))
+ CALL CCPOPN(46,'BADSPOT',2,2,80,IFAIL)
C *************************************
C
C
IF (MAXR.GT.MAXBOX) THEN
WRITE (IOUT,FMT=6002) MAXR,MAXBOX
6002 FORMAT (' Measurement box size of',I5,' is greater than ',
+ 'MAXBOX=',I5)
IF (BRIEF) WRITE (IBRIEF,FMT=6002) MAXR,MAXBOX
IF (ONLINE) WRITE (ITOUT,FMT=6002) MAXR,MAXBOX
CALL SHUTDOWN
END IF
C
C---- Open file for dumping specified reflections to badspots file
C
IF (DUMPSPOT) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6004)
6004 FORMAT (/,' Badspots output will contain specified ',
+ 'reflections read in from SPOTDUMP input file ')
WRITE (IOUT,FMT=6004)
IFAIL = 1
C
C ***********************************
CALL CCPOPN(IDU,'SPOTDUMP',3,1,80,IFAIL)
C ***********************************
C
I = 0
120 CONTINUE
I = I + 1
IF (I.LE.50) THEN
READ (IDU,FMT=*,END=130) (IHD(K,I),K=1,3)
GO TO 120
END IF
END IF
C
C---- Clear for statistics
C
130 NBADBG = 0
NBAD = 0
NOLO = 0
NEDGE = 0
NBOX = 0
NBZERO = 0
NOFR = 0
MAXBSI = 0
MINBSI = 200
C
C
DO 145 I = 1,32
NBGRHIST(I) = 0
145 CONTINUE
C
C
DO 150 I = 1,10
IANAL(I) = 0
AVSD(I) = 0.0
RATIO(I) = 0.0
150 CONTINUE
C
DO 152 I = 1,9
NRESSF(I) = 0
NRESSP(I) = 0
FIOVSDS(I) = 0.0
PIOVSDS(I) = 0.0
IRESSF(I) = 0
IRESSP(I) = 0
ISDRESSF(I) = 0
ISDRESSP(I) = 0
152 CONTINUE
C
DO 160 I = 1,13
IVSM(I) = 0
RSIGVSM(I) = 0
NIVSM(I) = 0
160 CONTINUE
C
C
DO 170 I = 1,16
XSH(I) = 0.0
YSH(I) = 0.0
NSH(I) = 0
170 CONTINUE
C
C
C---- Write header for badspots
C
IF (.NOT.ONLINE .AND. .NOT.MATCH) THEN
WRITE (IOUT,FMT=6006)
6006 FORMAT (1X,'List of badspots')
WRITE (IOUT,FMT=6024)
END IF
C
C
C
C *******************************************************************
C---- Final call, calculate and print statistics
C *******************************************************************
C
ELSE IF (LEN.EQ.1) THEN
C
DO 90 I = 1,10
C
C
IF (IANAL(I).NE.0) THEN
RATIO(I) = RATIO(I)/IANAL(I)
AVSD(I) = AVSD(I)/IANAL(I)
END IF
C
C
90 CONTINUE
C
C
C
C---- Calculate averages for I/sigma analysis
C
DO 92 I = 1,9
IF (I.LE.8) THEN
FIOVSDS(9) = FIOVSDS(9) + FIOVSDS(I)
PIOVSDS(9) = PIOVSDS(9) + PIOVSDS(I)
IRESSF(9) = IRESSF(9) + IRESSF(I)
IRESSP(9) = IRESSP(9) + IRESSP(I)
ISDRESSF(9) = ISDRESSF(9) + ISDRESSF(I)
ISDRESSP(9) = ISDRESSP(9) + ISDRESSP(I)
NRESSF(9) = NRESSF(9) + NRESSF(I)
NRESSP(9) = NRESSP(9) + NRESSP(I)
END IF
C
C---- Summation integration full
C
N = NRESSF(I)
IF (N.NE.0) THEN
FIOVSDS(I) = FIOVSDS(I)/N
IRESSF(I) = IRESSF(I)/N
ISDRESSF(I) = ISDRESSF(I)/N
END IF
C
C---- Summation integration partial
C
N = NRESSP(I)
IF (N.NE.0) THEN
PIOVSDS(I) = PIOVSDS(I)/N
IRESSP(I) = IRESSP(I)/N
ISDRESSP(I) = ISDRESSP(I)/N
END IF
92 CONTINUE
C
C
C ******************************
CALL REPORT(NBOXES,USEOVRLDDUM)
CALL XYSHIFT(0.0,0.0,0,0,XSH,YSH,NSH,2)
C ******************************
C
IF (.NOT.MATCH) REWIND 46
IF (ONLINE) WRITE (ITOUT,FMT=6018) NBAD
IF (BRIEF) WRITE (IBRIEF,FMT=6018) NBAD
6018 FORMAT (2X,'Number of bad spots =',I4)
WRITE (IOUT,FMT=6018) NBAD
IF (NBADBG.NE.0) THEN
WRITE(IOUT,6019) NBADBG,NBGMIN
IF (ONLINE) WRITE(ITOUT,6019) NBADBG,NBGMIN
IF (BRIEF) WRITE(IBRIEF,6019) NBADBG,NBGMIN
6019 FORMAT(/1X,I5,'Reflections rejected because fewer than',I4,
+ ' background pixels left after rejection')
END IF
C
C---- Skip badspot examination if in batch mode
C
IF (ONLINE.AND.(.NOT.MATCH)) THEN
C
C
IF (NBAD.NE.0) THEN
IF (BRIEF) WRITE (IBRIEF,FMT=6020)
WRITE (ITOUT,FMT=6020)
6020 FORMAT (2X,'Do you want to check bad spots(Y OR N)? ',$)
C
C **********
CALL YESNO(YES)
C **********
C
IF (YES) THEN
IMAP = 0
IF (BRIEF) WRITE (IBRIEF,FMT=6022)
WRITE (ITOUT,FMT=6022)
6022 FORMAT (2X,'Do you want a plot of each spot? ',$)
C
C **********
CALL YESNO(YES)
C **********
C
IF (.NOT.YES) IMAP = 1
C
N = 0
C
C
DO 100 I = 1,NBAD
READ (46) KREC,ISPOT,ISDBSI,IBGND,BGRMS,BGRATIO,
+ NXY,NXX,NYY,A,B,C
READ (46) (OD(II),II=1,NXY)
JREC = ABS(KREC)
C
C ***************
CALL GETHKL(JREC,IH)
C ***************
C
XCG = IH(6)
YCG = IH(7)
CALL MMTOPX(XC,YC,XCG,YCG)
IXPIX = NINT(XC*FACT)
IYPIX = NINT(YC*FACT)
WRITE (ITOUT,FMT=6024)
IF (BRIEF) WRITE (IBRIEF,FMT=6024)
6024 FORMAT (' H K L M XG YG XS ',
+ 'YS INT S.D. BGRATIO PLANE A B',
$ ' C')
WRITE (IOUT,FMT=6024)
WRITE (IOUT,FMT=6016) IH,IXPIX,IYPIX,ISPOT,ISDBSI,
+ BGRATIO,A,B,C
WRITE (ITOUT,FMT=6016) IH,ISPOT,ISDBSI,BGRATIO,
$ A,B,C
IF (BRIEF) WRITE (IBRIEF,FMT=6016) IH,ISPOT,
+ ISDBSI,BGRATIO,A,B,C
C
C
IF (IMAP.NE.1) THEN
C
C *****************************************
CALL SETMASK(MASK(1,1),LRAS)
C CALL RASPLOT(OD,NXX,NYY,MASK(1,1),IDR,ODSCAL)
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
C *****************************************
C
END IF
C
C
WRITE (ITOUT,FMT=6028)
IF (BRIEF) WRITE (IBRIEF,FMT=6028)
6028 FORMAT (' Reject (Y or N)? ',$)
WRITE (IOUT,FMT=6028)
C
C **********
CALL YESNO(YES)
C **********
C
IF (YES) WRITE (IOUT,FMT=6030)
6030 FORMAT (' Y')
IF (.NOT.YES) WRITE (IOUT,FMT=6032)
6032 FORMAT (' N')
C
IF (YES) THEN
IRECG = ABS(KREC)
ISDG(IRECG) = -9999
END IF
C
C
100 CONTINUE
ELSE
C---- No inspection of bad spots
C
C-----Flag nbad spots as rejected in generate file
C
DO 110 I = 1,NBAD
READ (46) KREC,ISPOT
READ (46) JUNK
IRECG = ABS(KREC)
ISDG(IRECG) = -9999
110 CONTINUE
C
C
END IF
END IF
END IF
C
C---- Write intensities etc back to generate file
C
MODEWR = 0
C
IF (BRIEF) WRITE(IBRIEF,FMT=6033)
6033 FORMAT(/,1X,'Writing intensities back to generate file')
C
IF (PRECESS) THEN
C
C **********************
CALL PWRGEN(MODEWR,PROFILEDUM)
C **********************
C
ELSE
C
C ****************************
CALL WRGEN(MODEWR,PROFILEDUM,SUMPART)
C ****************************
C
END IF
C
C
IF (ONLINE.AND.(.NOT.MATCH)) CLOSE (UNIT=46)
C
WRITE (IOUT,FMT=6034)
6034 FORMAT (1X,/15 ('@@@@'),/)
IF (ONLINE) WRITE (ITOUT,FMT=6034)
IF (BRIEF) WRITE (IBRIEF,FMT=6034)
C
C
C *******************************************************************
C---- Integrate reflection passed via /PEL/
C *******************************************************************
C
ELSE IF (LEN.GT.1) THEN
C
C---- Start calculation of integrated intensities
C
C
KREC = IBUFF(1)
IRECG = ABS(KREC)
IXPIX = IBUFF(2)
IYPIX = IBUFF(3)
NXX = IBUFF(4)
NYY = IBUFF(5)
NPBOX = IBUFF(6)
C
C---- If storing an expanded reflection list for automatch,
C set XREF,YREF to the sorted scanner coords
C note that IRECG is then the number of the reflection in
C the sorted list produced by GENSORT, not the record
C number in the generate file.
C
IF (MATCH) THEN
XREF(IRECG) = IXPIX
YREF(IRECG) = IYPIX
END IF
C
C
FULL = .FALSE.
C
C
IF (KREC.GE.0.AND.(.NOT.POSTREF)) THEN
FULL = .TRUE.
NOFR = NOFR + 1
END IF
C
C
C
C---- Test for change of masks
C
CALL GETSTRIP(NPBOX,ISTRIP)
IF (ISTRIP.EQ.ISTRIPCUR) GO TO 30
C
IF (DEBUG(49)) THEN
WRITE(IOUT,FMT=6035) ISTRIP,NPBOX
IF (ONLINE) WRITE(ITOUT,FMT=6035) ISTRIP,NPBOX
END IF
6035 FORMAT(1X,'SPROCESS, Setting up new masks for strip',I3,
+ ' NPBOX',I3)
C
ISTRIPCUR = ISTRIP
NFBOX = NPFIRST(ISTRIP)
DO 20 K = 1,NYLINE-1
C
C---- Test for valid box
C
IF (.NOT.BOX(NFBOX)) GOTO 22
NYY = ISIZE(NFBOX,2)
C
C ***********************
CALL SETMASK(MASK(1,K),LRAS)
CALL SETSUMS(MASK(1,K),LRAS,SUMPQ(1,K))
C ***********************
C
IF (DEBUG(49)) THEN
WRITE(IOUT,FMT=6037) K,NFBOX,NXX,NYY
IF (ONLINE) WRITE(ITOUT,FMT=6037) K,NFBOX,NXX,NYY
6037 FORMAT(1X,'Y index',I3,' NFBOX',I3,' NXX,NYY',2I4)
END IF
22 NFBOX = NFBOX + 1
20 CONTINUE
C
C
30 NYY = IBUFF(5)
C
C
NXY = NXX*NYY
C
C
CALL GETYIND(NPBOX,NY)
C
C
C---- Debug
C
IF (DEBUG(49).AND.(NCOUNT.LT.NDEBUG(49))) THEN
WRITE (IOUT,FMT=6010) IRECG,IXPIX,IYPIX,NOFR,NXX,NYY,
+ NXY,ISTRIPCUR,SCAI,EFAC
IF (ONLINE) WRITE (ITOUT,FMT=6010) IRECG,IXPIX,IYPIX,
+ NOFR,NXX,NYY,NXY,ISTRIPCUR,SCAI,EFAC
6010 FORMAT (1X,'IRECG =',I5,' IX,IY ',2I6,' NOFR=',I5,
+ 'NXX,NYY,NXY,ISTRIPCUR ',2I3,I5,I4,/1X,'SCAI ',
$ F8.4,' EFAC ',F10.4)
END IF
C
TPEAK = SUMPQ(5,NY)
TBGND = SUMPQ(6,NY)
C
C---- Read densities for one spot
C
N = 0
C
C---- Correct densities
C
DO 40 K = 1,NXY
C
C *********
CALL CBYTE2(K)
C *********
C
IF (IBA.LE.NULLPIX) THEN
GO TO 70
ELSE
IF (IBA.GT.CUTOFF) N = N + 1
IF (IMGP) THEN
OD(K) = IBA
ELSE
OD(K) = TABLE(IBA)
END IF
END IF
C
C
40 CONTINUE
C
C---- Dump pixel values if debug set
C
IF ((DEBUG(49).AND.SPOT)) THEN
C
C *****************************************
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
C CALL RASPLOT(OD,NXX,NYY,MASK(1,NY),IDR,ODSCAL)
C *****************************************
C
END IF
C
C---- If more than NOVPIX pixels have od.gt.cutoff, flag as overloaded
C except when doing pattern matching
C
IF ((N.GT.NOVPIX) .AND. (.NOT.MATCH)) THEN
NOLO = NOLO + 1
GO TO 80
END IF
C
C
C
C Note that MASKREJ, PQSUMS are not used in this S/R,
C but are required when INTEG is called from PROCESS. They are
C essentially dummy arguments here. (Declared Local Variables)
C **********************************************
CALL INTEG(OD,LRAS,MASK(1,NY),SUMPQ(1,NY),IDR,FULL,
+ BGSIG,MASKREJ,PQSUMS,NRFL)
C **********************************************
C
C
C---- Check that background under peak is not negative
C
IF (ASPOT(2).LT.0.0) THEN
WRITE(IOUT,FMT=6103) ASPOT(2),IDIVIDE
IF (ONLINE) WRITE(ITOUT,FMT=6103) ASPOT(2),IDIVIDE
6103 FORMAT(1X,'** FATAL ERROR **',/,1X,'The total background',
+ ' counts under the peak region has',/,1X,'become ',
+ 'negative (value is',F8.1,')after subtracting the ',
+ 'scanner adc',/,1X,'offset (value currently',I6,/,
$ 1X,'Reset the scanner offset using',
+ ' keyword ADCOFFSET followed by value')
END IF
IF (DEBUG(49).AND.(NCOUNT.LT.NDEBUG(49))) THEN
NCOUNT = NCOUNT + 1
WRITE(IOUT,FMT=6011) ASPOT
IF (ONLINE) WRITE(ITOUT,FMT=6011) ASPOT
END IF
6011 FORMAT(1X,'SPROCESS, after calling INTEG, ASPOT:',/,
+ (1X,6F12.0))
C---- Test that it has not rejected an unacceptable number of
C background points. This is set in INTEG to ensure at least
C NBGMIN (set using keywords REJECTION MINBG) background pixels left,
C and if not, flagged with ASPOT(1)=-9999. No data are available for
C these reflections as the background plane is not calculated.
IF (ASPOT(1).EQ.-9999.0) THEN
NBADBG = NBADBG + 1
ISDG(IRECG) = -9999
ISDPRO(IRECG) = -9999
IF (MATCH) THEN
INTREF(IRECG) = 0
ISDREF(IRECG) = -9999
END IF
ISPOT = -9999
ISDBSI = 0
IBGND = 0
RMSBG = 0.0
BGRATIO = 0.0
C
C---- If this is a spot for post refinement, just return
C
IF (POSTREF) RETURN
GOTO 65
END IF
C
C---- Calculate standard deviation of intensity
C
VSPOT = GAIN*SOD
VBG = TPEAK*RMSBG
VBG = VBG*VBG/TBGND
XX = (SOD/BOXFAC)**2*TPEAK
C
C---- Last term is to allow for scanner instrument errors
C
C change to counting statistics
C ISDBSI = SQRT(2*VBG+ABS(VSPOT)+EFAC*EFAC*XX)*SCAI + 0.5
C
C----- Now that the default EFAC is used rather than the value calculated
C for this image, no longer make the distinction on how variance is
C calculated. A.G.W.L. 12/11/01
C
C IF (POSTREF.OR.MATCH) THEN
C VARTOT=GAIN*(SOD+BGND+BGND*TPEAK/TBGND)
C ELSE
C
VARTOT=GAIN*(SOD+BGND+BGND*TPEAK/TBGND)+EFAC*EFAC*XX
C
C END IF
IF (VARTOT.LE.0.0) VARTOT = 0
ISDBSI = SCAI*SQRT(VARTOT) + 0.5
ISPOT = SCAI*SOD + 0.5
C
C---- Test for unreasonable standard deviation (and too large to store
C as I*2). This can only result from an error except when pattern
C matching where overloads are allowed (so just reset and continue).
C
c write(iout,fmt=1066)ih,ixpix,iypix,nxx,nyy,nxy,istripcur,scai
c $ ,efac,sod,bgnd,tpeak,tbgnd,xx,boxfac,rmsbg,isdbsi
c 1066 format(60('-'),/,'IH = ',3i4,4i8,/,'IXPIX, IYPIX = ',2I10,/,
c $ 'NXX,NYY,NXY = ',3I6,' ISTRIPCUR = ',I5,/,
c $ 'SCAI = ',F8.3,' EFAC = ',F8.3,' SOD = ',E12.4,
c $ ' BGND = ',F12.3,' TPEAK = ',F12.4,' TBGND = ',F12.4,/,
c $ 'XX = ',E12.4,' BOXFAC = ',F10.3,' RMSBG = ',F9.4,
c $ ' ISDBSI = ',I10)
IF (ISDBSI.GT.32767) THEN
IF (MATCH) THEN
ISDBSI = 32000
ELSE
IF (ISDBSI.GT.65535)THEN
WRITE (IOUT,FMT=6108) ISDBSI
IF (ONLINE) WRITE (ITOUT,FMT=6108) ISDBSI
IF (BRIEF) WRITE (IBRIEF,FMT=6108) ISDBSI
6108 FORMAT(/,/,1X,'Error 6108 in subroutine sprocess',/,
$ 1X,'**** SERIOUS ERROR ****',/,1X,
$ 'The standard deviation of the integrated ',
$ 'intensity is',I10,/,1X,'which is greater t',
$ 'han the maximum allowed value (32767). Somet',
$ 'hing is seriously wrong',/,1X,'The pixel va',
$ 'lues for this spot follow',/)
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
WRITE(IOUT,FMT=6109) EFAC
IF (ONLINE) WRITE(ITOUT,FMT=6109) EFAC
6109 FORMAT(/,1X
& ,'The value of the scanner error factor used '
& ,'in the calculation of the',/,1X
& ,'standard deviation',' is',F12.3
& ,'.. is this correct ?')
CALL SHUTDOWN
ELSE
WRITE(IOUT,FMT=6110)ISDBSI
IF (ONLINE) WRITE (ITOUT,FMT=6110) ISDBSI
IF (BRIEF) WRITE (IBRIEF,FMT=6110) ISDBSI
ISDBSI = 32000
6110 FORMAT(/,/,1X,'Error 6110 in subroutine sprocess',
$ /,4(1X,'**** WARNING ****'),/,1X,
$ 'The standard deviation of the integrated ',
$ 'intensity is',I10,/,1X,'which is greater t',
$ 'han the maximum allowed value (32767) Somet',
$ 'hing is wrong',/,1X,'The value has been re-',
$ 'set to 32000, but you should examine this ',
$ 'spot carefully. The pixel va',
$ 'lues for this spot follow',/)
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
WRITE(IOUT,FMT=6109) EFAC
IF (ONLINE) WRITE(ITOUT,FMT=6109) EFAC
ENDIF
END IF
END IF
C
IF (BGND.LE.0.0) THEN
WRITE (ITOUT,FMT=6012) IXPIX,IYPIX
IF (BRIEF) WRITE (IBRIEF,FMT=6012) IXPIX,IYPIX
6012 FORMAT (' Zero background spot, X,Y ',2I5)
BGND = 0.01
NBZERO = NBZERO + 1
END IF
C
C
BGRATIO = RMSBG/SQRT(GAIN*BGND/TPEAK)
IBGND = SCAI*BGND + 0.5
C
C Calculate maximum gradient
C
IF (C.GT.0.0) THEN
GRADM = MAX(ABS(A),ABS(B))/C
ELSE
GRADM = 0.0
END IF
C
C
C---- For postrefinement, save this reflection if not a "badspot"
C
IF (POSTREF) THEN
CALL GETHKL(IRECG,IH)
C
C---- C is the local background for the spot
C
IF((BGRATIO.LE.BGRAT).AND.(GRADM.LT.GRADMAX))THEN
IF(.NOT.NEWPREF)THEN
INTPOST(1) = ISPOT
SIGPOST(1) = ISDBSI
INTPOST(2) = 0
SIGPOST(2) = 0
PHIPOST = 0.0
c 21032002
c---- g77 compiler points out that call to postref has an inconsistent
c number of arguments below. Should 'multiseg' be .false. or .true.?)
c
CALL POSTREFL(IRECG,INTPOST,SIGPOST,C,
+ RESID,RETA,RDIVH,RDIVV,FIXEDDUM,
+ ISTAT,LASTREC,NEWPREF,0,.false.)
ELSE
KHF = IRG(IRECG)
IF (KHF.GT.0) THEN
IMODE = 2
C
C---- Transfer intensity and sigma into INTPOST,SIGPOST for partials only
C
INTPOST(1) = ISPOT
SIGPOST(1) = ISDBSI
c 21032002
c---- g77 compiler points out that call to modarray has an inconsistent
c number of arguments below. Should PHIPOST be included?
c CALL MODARRAY(IMODE,C,IRECG,LASTREC,
c $ INTPOST,SIGPOST,PHIPOST)
CALL MODARRAY(IMODE,C,IRECG,LASTREC,
$ INTPOST,SIGPOST)
C
C---- LASTREC is set equal to IRECG for completed reflections by MODARRAY
C
IF (LASTREC.EQ.IRECG)THEN
c 21032002
c---- g77 compiler points out that call to postref has an inconsistent
c number of arguments below. Should 'multiseg' be .false. or .true.?)
c
CALL POSTREFL(IRECG,INTPOST,SIGPOST,
+ C,RESID,RETA,
+ RDIVH,RDIVV,FIXEDDUM,ISTAT,LASTREC,
+ NEWPREF,0,.false.)
ENDIF
ENDIF
ENDIF
ENDIF
IF (DEBUG(49).AND.(NCOUNT.LT.NDEBUG(49))) THEN
BADFLAG = ((BGRATIO.GT.BGRAT).OR.(GRADM.GT.GRADMAX))
WRITE(IOUT,FMT=6013)
+ (IH(I),I=1,3),ISPOT,IRECG, IXPIX,IYPIX,
+ ISDBSI,BADFLAG
IF (ONLINE) WRITE(ITOUT,FMT=6013)
+ (IH(I),I=1,3),IRECG,IXPIX,IYPIX,
+ ISPOT,ISDBSI,BADFLAG
END IF
6013 FORMAT(1X,'H,K,L = ',3I4,
+ ' IRECG = ',I8,' IXPIX, IYPIX = ',2I5,
+ ' I,SIGMA',2I8,' Badspot flag ',L1)
RETURN
END IF
65 IF (MATCH) THEN
IF (ASPOT(1).NE.-9999.0) THEN
INTREF(IRECG) = ISPOT
C
C---- Do not use EFAC when pattern matching (it will have its default
C value of -999 if profile fitting!!
C
ISDREF(IRECG) = SQRT(VARTOT)*SCAI + 0.5
if(resest)then
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
IPART = IMG(IRECG)
CALL STATS(ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS,NSBOX,IPART,FULL,OVRLFITDUM,ITHBIN)
ENDIF
END IF
ELSE
IF (ASPOT(1).EQ.-9999.0) GOTO 66
INTG(IRECG) = ISPOT
ISDG(IRECG) = ISDBSI
C
IF (FULL) THEN
IF (ISPOT.GE.IRANGE(3)) THEN
XX = IXPIX/FACT
YY = IYPIX/FACT
DELX = DELX/FACT
DELY = DELY/FACT
C
IXX = XX - XCEN
IYY = YY - YCEN
C
C ****************************************
CALL XYSHIFT(DELX,DELY,IXX,IYY,XSH,YSH,NSH,1)
C ****************************************
C
END IF
END IF
C
C
MAXBSI = MAX(MAXBSI,ISPOT)
MINBSI = MIN(MINBSI,ISPOT)
C
C---- Background point rejection histogram
C
NREJ = ASPOT(15)
II = (NREJ-1)/5 +2
IF (NREJ.EQ.0) II = 1
IF (II.GT.31) II = 32
NBGRHIST(II) = NBGRHIST(II) + 1
C
C---- Add contributions for statistics
C
C
CALL GETBIN(IRECG,ITHBIN,NBIN1,DSTSQ)
IPART = IMG(IRECG)
CALL STATS(ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS,NSBOX,IPART,FULL,OVRLFITDUM,ITHBIN)
C
C---- Only allow dumping specific reflections to badspot file if online.
C
66 IF ((DUMPSPOT) .AND. (ONLINE) .AND.(.NOT.MATCH)) THEN
C
C **************************
CALL COMPR(KREC,IHD,LDUMP,NSPT)
C **************************
C
IF (LDUMP) THEN
WRITE (46) KREC,ISPOT,ISDBSI,IBGND,RMSBG,BGRATIO,NXY,
+ NXX,NYY,A,B,C
WRITE (46) (OD(II),II=1,NXY)
NBAD = NBAD + 1
ELSE
RETURN
END IF
END IF
END IF
C
C---- Test for badspots
C If pattern matching, only test bgratio for spots with
C negative intensity
C
IF (((BGRATIO.GT.BGRAT).AND. ((.NOT.MATCH).OR.
+ (MATCH.AND. (ISPOT.LT.0)))) .OR.
+ (ISPOT.LT.-5*ISDBSI).OR.(GRADM.GT.GRADMAX)) THEN
IF (MATCH) THEN
ISDREF(IRECG) = -9999
ELSE
C
C---- Only write badspots to file if running online
C
IF (ONLINE.AND.(.NOT.MATCH)) THEN
WRITE (46) KREC,ISPOT,ISDBSI,IBGND,RMSBG,BGRATIO,NXY,
+ NXX,NYY,A,B,C
WRITE (46) (OD(II),II=1,NXY)
END IF
C
C
NBAD = NBAD + 1
IF (DEBUG(49)) THEN
WRITE (IOUT,FMT=6014) KREC,ISPOT,
+ ISDBSI,IBGND,RMSBG,BGRATIO,NXY,NXX,NYY
IF (ONLINE) WRITE (ITOUT,FMT=6014) KREC,ISPOT,
+ ISDBSI,IBGND,RMSBG,BGRATIO,NXY,NXX,NYY
6014 FORMAT (1X,'BADSPOT, KREC,ISPOT,ISDBSI,IBGND:',4I6,
$ /,1X,' RMSBG, BGRATIO',2F5.1,' NXY,NXX,NYY',3I5)
END IF
C
C---- If running in batch mode, flag bad spots as rejected
C
IF (.NOT.ONLINE) THEN
C
C ****************
CALL GETHKL(IRECG,IH)
C ****************
C
XCG = XG(IRECG)
YCG = YG(IRECG)
CALL MMTOPX(XC,YC,XCG,YCG)
IXPIX = NINT(XC*FACT)
IYPIX = NINT(YC*FACT)
IF (BADPLOT) WRITE(IOUT,6024)
WRITE (IOUT,FMT=6016) (IH(II),II=1,4),XG(IRECG),
+ YG(IRECG),IXPIX,IYPIX,ISPOT,ISDBSI,BGRATIO,
$ A,B,C
6016 FORMAT (1X,4I4,2F8.1,4I6,4F8.1)
IF (BADPLOT) THEN
WRITE(IOUT,FMT=6017)
6017 FORMAT(1X,'Pixel values for this spot')
MAXPIX = 0
CALL ODPLOT4(OD,NXX,NYY,1,MAXPIX)
WRITE(IOUT,6015)
6015 FORMAT(//)
END IF
ISDG(IRECG) = -9999
END IF
END IF
END IF
C
C
RETURN
C
C
70 NEDGE = NEDGE + 1
INTG(IRECG) = -9999
ISDG(IRECG) = -9999
RETURN
C
C
80 INTG(IRECG) = IOVER
ISDG(IRECG) = -9999
END IF
RETURN
END
C== SPTEST ==
C
SUBROUTINE SPTEST(X,Y,DSTSQ,DSTMAX2,DSTMIN2,IFLAG,IFAIL)
C ================================================
C
IMPLICIT NONE
C IFLAG (input) is set in DSTAR (where it is called KH):
C IFLAG = 0 Full spot
C = 10 Spot within cusp (set in subroutine REEK)
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C = 2 Extends over too many images
C
C
C Tests R, X, Y, and DSTAR - sets flag IFAIL (output)
C
C IFAIL = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C There is no need to test RMAX as spot would fail DSTAR test
C Note that too wide in phi is only flagged if spot passes all other
C tests (except overlap)
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
REAL DSTMAX2,DSTMIN2,DSTSQ,X,Y
INTEGER IFAIL,IFLAG
C ..
C .. Local Scalars ..
INTEGER I
REAL R,RDSQ,XMID,YMID,XC,YC,RMN,XSCN,YSCN,XDET,YDET,RESEX1,
+ RESEX2,XTEMP
C ..
C .. External Subroutines ..
EXTERNAL MMTOPX
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C ..
SAVE
C
C
IFAIL = 0
R = X*X + Y*Y
C
C---- Test that this spot is within the scanned area of the detector.
C This is important for the Mar scanner, particularly if the direct
C beam is NOT in the centre of the image
C
IF (CIRCULAR) THEN
CALL MMTOPX(XC,YC,X,Y)
XMID = (0.5*NREC)/FACT
YMID = (0.5*IYLEN)/FACT
IF ((RSCANX.NE.0.0).OR.(RSCANY.NE.0.0)) THEN
XMID = RSCANX
YMID = RSCANY
END IF
CAL WRITE(6,*),'XC,YC,XMID,YMID',XC,YC,XMID,YMID,RSCANX,RSCANY
RDSQ = (XC-XMID)**2 + (YC-YMID)**2
ELSE IF (ORTHOG) THEN
CALL MMTOPX(XC,YC,X,Y)
XMID = (0.5*NREC)/FACT
YMID = (0.5*IYLEN)/FACT
XSCN = (XC-XMID)
YSCN = (YC-YMID)
END IF
XDET = (XC-XCEN)
YDET = (YC-YCEN)
C
RMN = R
IF ((RMINX.NE.0.0).OR.(RMINY.NE.0.0)) THEN
CALL MMTOPX(XC,YC,X,Y)
RMN = (XC-RMINX)**2 + (YC-RMINY)**2
END IF
C
CAL WRITE(6,*),'RMNSQD,XMAX,YMAX,XMIN,YMIN,RSCANSQ,SPIRAL',
CAL + RMNSQD,XMAX,YMAX,XMIN,YMIN,RSCANSQ,SPIRAL
CAL WRITE(6,*),'RMN,Xdet,Ydet,RDSQ',RMN,Xdet,Ydet,RDSQ
IF (DSTSQ.GT.DSTMAX2) THEN
IFAIL = 4
ELSE IF (DSTSQ.LT.DSTMIN2) THEN
IFAIL = 4
ELSE IF (RMN.LT.RMNSQD) THEN
IFAIL = 1
ELSE IF (ABS(XDET).GT.XMAX .OR. ABS(XDET).LT.XMIN) THEN
IFAIL = 1
ELSE IF (ABS(YDET).GT.YMAX .OR. ABS(YDET).LT.YMIN) THEN
IFAIL = 1
ELSE IF (CIRCULAR.AND.(RDSQ.GE.RSCANSQ)) THEN
IFAIL = 1
ELSE IF (ORTHOG.AND.
+ ((ABS(XSCN).GT.XSCAN).OR.(ABS(YSCN).GT.YSCAN))) THEN
IFAIL = 1
ELSE IF (IFLAG.GE.3) THEN
IFAIL = IFLAG
END IF
IF (NEXCL.GT.0) THEN
DO 10 I = 1,NEXCL
RESEX1 = WAVE/RESEXH(I)
RESEX2 = WAVE/RESEXL(I)
RESEX1 = RESEX1**2
RESEX2 = RESEX2**2
IF ((DSTSQ.GT.RESEX2).AND.(DSTSQ.LT.RESEX1)) IFAIL = 4
10 CONTINUE
END IF
IF (NXYEXC.GT.0) THEN
DO 20 I=1,NXYEXC
IF (YC.GE.XYEXC(2,I).AND.YC.LE.XYEXC(4,I)) THEN
XTEMP=XC
IF (INVERTX) XTEMP=FLOAT(NREC)*RAST*100.0-XTEMP
IF (XTEMP.GE.XYEXC(1,I).AND.XTEMP.LE.XYEXC(3,I)) IFAIL=1
ENDIF
20 CONTINUE
ENDIF
C
C
END
C== START ==
SUBROUTINE START(GENFILE,GTITLE,IDENT,INOGEN,NTIMES,NPACK)
C ========================================================
IMPLICIT NONE
C
C
C---- This subroutine is called once for each new generate file
C
C---- Opens generate file, and writes header information.
C If online, displays raster box and allows raster params
C to be changed.
C Sets up factor to convert generate file units to scanner units
C NB Although IAX (IAX(3) is JUMPAX) is written to header it has not
C yet been set up (done in call to SETAX in REEK) so all values will
C be zero.
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
INTEGER NPARM
PARAMETER (NPARM=200)
C ..
C .. Scalar Arguments ..
INTEGER INOGEN,NTIMES,NPACK
CHARACTER IDENT*40,GENFILE*200,GTITLE*80
C ..
C .. ARRAY Arguments ..
C ..
C .. Local Scalars ..
REAL DTOR
INTEGER HXS,HYS,I,IBNEG,IBPOS,IBULGE,IER,IPNT,ITILT,ITWIST,IVERT,
+ J,K,NC,NCC,NRX,NRY,NXS,NYS,TST,IFAIL,IDUMMY,
+ JJNREC,JIYLEN,NTOK
CHARACTER CBUFF*88,LINE*400
C ..
C .. Local Arrays ..
REAL RBUFF(180),VALUE(NPARM)
INTEGER DMM(5),IBUFF(180),MASK(MAXBOX),IBMASK(MAXBOX),
+ IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL BELL,PLOTRAS,QOPEN,QREAD,QSEEK,MPARSER,
+ QWRITE,SETMASK
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/cconst8.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cconst8.h
C---- START of include file cconst8.h
C
C
C .. Arrays in Common /CCONST8/ ..
REAL CCOMA
INTEGER CCXA,CCYA,CBARA
C ..
C .. Common block /CCONST8/ ..
COMMON /CCONST8/CCOMA(8),CCXA(8),CCYA(8),CBARA(8)
C ..
C
C
C
C&&*&& end_include ../inc/cconst8.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/sys.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sys.h
C---- START of include file sys.h
C
C
C .. Scalars in Common Block /SYS/ ..
INTEGER ISYS
C ..
C .. Arrays in Common Block /SYS/ ..
INTEGER KSYS
C ..
C .. Common Block /SYS/ ..
COMMON /SYS/ISYS,KSYS(3)
C ..
C
C
C&&*&& end_include ../inc/sys.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Equivalences ..
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (RBUFF,IBUFF), (IBUFF,CBUFF)
C
C---- Open generate file
C
C **************************
CALL QOPEN(IUNIT,GENFILE,'UNKNOWN')
CALL QMODE(IUNIT,0,IDUMMY)
C **************************
C
CBUFF(1:80) = GTITLE
CBUFF(81:88) = IDENT(1:8)
WRITE (IOUT,FMT=6000) GTITLE(1:LENSTR(GTITLE)),
+ IDENT(1:LENSTR(IDENT))
6000 FORMAT (//1X,'Title for MTZ and GENERATE Files (TITLE):',/1X,A,
+ /,1X,'Crystal identifier (IDENT): ',A)
IF (ONLINE) WRITE (ITOUT,FMT=6000) GTITLE(1:LENSTR(GTITLE)),
+ IDENT(1:LENSTR(IDENT))
IPNT = 22
C
C
DO 20 J = 1,3
DO 10 I = 1,3
IPNT = IPNT + 1
RBUFF(IPNT) = AMAT(I,J)
10 CONTINUE
20 CONTINUE
C
C
DO 30 I = 1,3
IPNT = IPNT + 1
C
C---- Put missetts into range -180 to 180
C
IF (DELPHI(I).GT.180.0) DELPHI(I) = DELPHI(I) - 360.0
IF (DELPHI(I).LT.-180.0) DELPHI(I) = DELPHI(I) + 360.0
RBUFF(IPNT) = DELPHI(I)
30 CONTINUE
C
C
RBUFF(35) = XTOFD
RBUFF(36) = XMIN
RBUFF(37) = XMAX
RBUFF(38) = YMAX
RBUFF(39) = RMIN
RBUFF(40) = RMAX
RMNSQD = RMIN*RMIN
CAL-- Change next line when allowing multiple SERIAL keywords
CAL IBUFF(41) = NPACKS
IBUFF(41) = NPACK
IBUFF(42) = MINT
IBUFF(43) = ICASS
IBUFF(44) = MINDTX
IBUFF(45) = MINDTY
IBUFF(46) = ISYS
IPNT = 46
C
C
DO 40 I = 1,3
IPNT = IPNT + 1
IBUFF(IPNT) = KSYS(I)
40 CONTINUE
C
C
RBUFF(50) = DSTMAX
CAL DSTMAXS = DSTMAX
C
C---- ETA,DIVH,DIVV are stored in generate file as full widths in degrees.
C
DTOR = ATAN(1.0)*4.0/180.0
RBUFF(51) = 2.0*DIVH/DTOR
RBUFF(52) = 2.0*DIVV/DTOR
RBUFF(53) = DELAMB
IPNT = 53
DO 50 I = 1,5
IPNT = IPNT + 1
IF (IRAS(I).LT.1) IRAS(I) = 1
IBUFF(IPNT) = IRAS(I)
50 CONTINUE
C
C---- Pixel size in microns
C
RBUFF(59) = 100.0*RAST
IPNT = 59
C
C---- Watch out, IAX has not yet been set up, so it will contain zero's
C
DO 60 I = 1,3
IPNT = IPNT + 1
IBUFF(IPNT) = IAX(I)
60 CONTINUE
C
C
RBUFF(63) = WAVE
IBUFF(64) = ISYN
C---- ETA,DIVH,DIVV are stored in generate file as full widths in degrees.
C
RBUFF(65) = 2.0*ETA/DTOR
RBUFF(66) = DELCOR
C
IPNT = 66
DO 52 I=1,6
IPNT = IPNT + 1
IBUFF(IPNT) = LCELL(I)
52 CONTINUE
C
C---- Now that generation is done in MOSFLM, INOGEN is always 1
C
INOGEN = 1
IBUFF(73) = INOGEN
C
C
C---- Print scanner unit
C SCNSZ is derived from the status word for the scanner
C and gives the scanner unit in multiples of 25 microns
C read measurement box parameters
C
C
SCNSZ = (40.0*RAST)
C
C---- FACT is the factor used through-out the program to
C transform from generate-file units (10 micron) to scanner units.
C
FACT = 0.4/SCNSZ
C
IF (DEBUG(2)) THEN
WRITE (IOUT,FMT=6004) NPACKS,NPACK,XTOFD,MINT,JUMPAX,
+ VEE,RAST,IRAS,XMIN,XMAX,YMAX,RMIN,RMAX,ICASS,MINDTX,MINDTY,
+ SCNSZ,FACT,DSTMAX
IF (ONLINE) WRITE (ITOUT,FMT=6004) NPACKS,NPACK,XTOFD,MINT,
+ JUMPAX,VEE,RAST,IRAS,XMIN,XMAX,YMAX,RMIN,RMAX,ICASS,MINDTX,
+ MINDTY,SCNSZ,FACT,DSTMAX
END IF
6004 FORMAT(1X,'***** DEBUG OUTPUT FROM SUBROUTINE START *****',/,1X,
+ 'NPACKS=',I5,' NPACK=',I3,' XTOFD=',I6,
+ ' MINT=',I4,' JUMPAX=',I2,
+ ' VEE=',L2,' RAST=',F6.3,/1X,'RASTER',5I3,/,1X,
+ 'XMIN,XMAX',
+ 2F8.1,' YMAX',F8.1,' RMIN,RMAX',2F8.1,/,1X,'ICASS',I3,
+ ' MINDTX,MINDTY',2I8,' SCNSZ',F6.3,' FACT',F8.4,
+ /,1X,'DSTMAX',F9.6)
70 CONTINUE
C
C---- Transform some of the box parameters to odd number
C of scanner units
C
HXS = NXS/2
HYS = NYS/2
NXS = HXS*2 + 1
NYS = HYS*2 + 1
C
C---- Print box parameters and read new ones
C draw shape of measurement box
C
C ************************
C
C---- Do not display box if this is not the first run
C
CAL NEVER DO THIS NOW
C
NTIMES = 2
IF (NTIMES.GT.1) GOTO 100
C
WRITE (IOUT,FMT=6006) IRAS
6006 FORMAT (1X,'Initial measurement box parameters:',/,1X,
+ ' NXS NYS NC NRX NRY ',/,1X,5I5)
C
IF (.NOT.BRIEF) THEN
CALL SETMASK(MASK,IRAS)
CALL PLOTRAS(MASK,IRAS,IBMASK,NXS,NYS)
C ********************************
C
C
C
C
IF (ONLINE) THEN
C
WRITE (ITOUT,FMT=6007)
6007 FORMAT (' NXS NYS NC NRX NRY ')
C ****
C IF(LBELL)CALL BELL
C ****
C
WRITE (ITOUT,FMT=6008) IRAS
6008 FORMAT (1X,5I5,' ? (C/R to continue, otherwise enter new values)')
C
C---- Read next line
C
C ******************************************************
CALL MPARSER(ITIN,IOUT,LINE,IBEG,IEND,ITYP,VALUE,
$ IDEC,NTOK)
C ******************************************************
C
C---- eof or no input ?
C
IF ((NTOK.EQ.-1).OR.(NTOK.EQ.0)) THEN
GOTO 100
ELSE IF (NTOK.NE.5) THEN
WRITE(IOUT,FMT=6010) NTOK
IF (ONLINE) WRITE(ITOUT,FMT=6010) NTOK
6010 FORMAT(1X,'Need 5 values, but',I3,' input, line ignored ')
GOTO 100
ELSE
C
C---- Check we have 5 numbers
C
DO 72 I = 1,5
IF (ITYP(I).NE.2) THEN
WRITE(IOUT,FMT=6012) LINE(1:80),I
IF (ONLINE) WRITE(ITOUT,FMT=6012) LINE(1:80),I
6012 FORMAT(1X,'*** ERROR ***',/,1X,'The input line is: ',A,
+ /,1X,'The',I3,'th token is not a number',
+ '...line ignored')
GOTO 100
END IF
DMM(I) = NINT(VALUE(I))
72 CONTINUE
END IF
C
TST = 0
C
C
DO 80 I = 1,5
C
C
IF (DMM(I).NE.0) THEN
NEWRAS = 1
TST = 1
C
C
IF (DMM(I).EQ.99) THEN
IRAS(I) = 0
ELSE
IRAS(I) = DMM(I)
END IF
C
C
END IF
80 CONTINUE
C
C
IF (TST.EQ.1) GO TO 70
ELSE
GO TO 100
END IF
C
C---- Update raster parameters on generate file
C
IF (NEWRAS.EQ.1) THEN
C
C
IPNT = 53
C
C
DO 90 I = 1,5
IPNT = IPNT + 1
IBUFF(IPNT) = IRAS(I)
90 CONTINUE
C
C
NEWRAS = 0
END IF
END IF
C
C---- Write out generate file header
C
C *******************
100 CALL QSEEK(IUNIT,1,1,36)
C *******************
C ***********************
CALL QWRITE(IUNIT,IBUFF,720)
C ***********************
IPACKREC = 21
IPACKHEAD = IPACKREC
C
C---- Take care of perpendicular distance to film
C for vee-shaped cassette = xtofd*sqrt(3)/2
C
DTOFD = XTOFD
IF (VEE) DTOFD = DTOFD*0.866
RETURN
C
C
END
C== STARTMTZ ==
SUBROUTINE STARTMTZ
C ===================
IMPLICIT NONE
C
C
C---- This subroutine is called once for each new mtz file
C Opens mtz file, writes file header information.
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Local Scalars ..
INTEGER IAPPND,MTITOT,IPRINT,NHSOUT
CHARACTER LATTYP*1
CHARACTER LSPRGO(MCOLS)*30,CTPRGO(MCOLS)*1,HISOUT*80,DATEMT*8
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL CCPDAT,MTZINI,LWOPEN,LWCLAB,LWTITL,
+ LWHIST,ASUSET,CENTRIC,EPSLN,LWSYMM,LWCELL
C ..
C .. Common blocks ..
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
c-harvest
C&&*&& include ../inc/mharvest.f
INTEGER MAXMTZ
PARAMETER (MAXMTZ = 16)
C .. Scalars in common block /CHARVEST/ ..
CHARACTER HVERSION*80,ProjectName*20,DataSetName*20,
+ HBEAMLINE*10,Precipitant*80,
+ PNAME_COLS(MAXMTZ)*20,
+ DNAME_COLS(MAXMTZ)*20
C .. Scalars in common block /IHARVEST/ ..
LOGICAL USECWD,PNAMEgiven,DNAMEgiven,DOHARVEST
REAL PHhar,Hartemp,
+ HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
CHARACTER*3 MKDIRMODE,CHMODMODE
INTEGER KHFLMS
C ..
C .. Common block /CHARVEST/ ..
COMMON /CHARVEST/HVERSION,ProjectName,DataSetName,
+ HBEAMLINE,Precipitant,
+ PNAME_COLS,DNAME_COLS
C .. Common block /IHARVEST/ ..
COMMON /IHARVEST/USECWD,PHhar,Hartemp,KHFLMS,
+ PNAMEgiven,DNAMEgiven,DOHARVEST,
+ HARETA,HARDIV,HARDIH,MKDIRMODE,CHMODMODE
C ..
C&&*&& end_include ../inc/mharvest.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
c-harvest
C ..
SAVE
C .. Data statements ..
DATA LSPRGO/'H', 'K', 'L', 'M/ISYM', 'BATCH', 'I', 'SIGI',
+ 'IPR', 'SIGIPR', 'FRACTIONCALC','XDET','YDET','ROT',
+ 'WIDTH','LP','MPART'/
DATA CTPRGO/
+ 'H','H','H','Y','B','J','Q','J','Q','R','R','R','R','R','R','R'/
C ..
C
C---- Now open mtz file
C
CALL MTZINI
C
C
C---- CALL to open an MTZ file for write.
C Arguments :
C INDEX INTEGER indicates which MTZ file - 1 index
C points to both input and output files
C FILNAM CHARACTER name of file to be opened
C CHARACTER FILNAM* (*)
C
C
MTZOUT = 1
MTZOPEN = .TRUE.
C
C ***************************************
CALL LWOPEN(MTZOUT,MTZNAM(1:LENSTR(MTZNAM)))
C ***************************************
C
C---- Build completely new list of labels
C
C---- CALL to write the column labels and column types
C to the header of an output MTZ file. This is simpler than LWASSN
C as it doesn't look for column assignments and doesn't check
C back to the input file at all - so the output column labels
C are exactly what come into this CALL in CLABS.
C---- Arguments :
C MTZOUT (I) INTEGER indicates which MTZ file - 1 index
C points to both input and output files
C
C LSPRGO (I) CHARACTER*30 array of dimension at least MCOLS
C containing the column labels on entry
C
C MCOLS (I) INTEGER number of columns input
C
C CTPRGO (I) CHARACTER*1 array of dimension at least MCOLS
C containing the column types on entry
C
C IAPPND (I) INTEGER =0 replace all existing labels and types
C =1 append to the existing lbls & types
C
C
IAPPND = 0
C
C ******************************************
c-harvest
c-old CALL LWCLAB(MTZOUT,LSPRGO,MCOLS,CTPRGO,IAPPND)
C
C---- Store the project name and dataset name in the mtz header:
C Subroutine to add dataset information to the output MTZ file header.
C Datasets identified by the PROTEIN_NAME/DATASET_NAME pair are
C appended to the MTZ header one at a time.
C Checks to see if the PROTEIN_NAME/DATASET_NAME pair is already
C included; if so, the dataset is not appended.
C Redundant datasets are removed in LWCLOS.
C
c---- expects scalar CHARACTER*20 PROTEIN_NAME,DATASET_NAME
c
chrp18102000 CALL LWID(MTZOUT,PROJECTNAME,DATASETNAME)
CALL LWIDC(MTZOUT,PROJECTNAME,DATASETNAME,CELL,WAVE)
CALL LWCLAB(MTZOUT,LSPRGO,MCOLS,CTPRGO,IAPPND)
C
C---- Subroutine to associate dataset entry with each column for
C the output MTZ file.
C
c---- expects char*20 array of size mcols
c
CALL LWIDAS(MTZOUT,MCOLS,PNAME_COLS,DNAME_COLS,0)
c-harvest
C ******************************************
C
C
C MTITOT Write title flag " meaning "
C =0 replace old title with new one
C =1 append new one to old, with one space
C
MTITOT = 0
C
C ****************************
CALL LWTITL(MTZOUT,GTITLE,MTITOT)
C ****************************
C--- One line of history
C
NHSOUT = 1
CALL CCPDAT(DATEMT)
HISOUT = ' From MOSFLM run on '//DATEMT
C
C
C ****************************
CALL LWHIST(MTZOUT,HISOUT,NHSOUT)
C ****************************
C
C
C---- Set up symmetry (RDSYMM must be called first )
C Set printing flag to DEBUG for CONTROL
C
C *********************************************************
CALL ASUSET(SPGNAM,NUMSPG,PGNAME,NSYM,RSYM,NSYMP,NLAUE,DEBUG(52))
C *********************************************************
C
C
C---- CALL to update the symmetry operations and information
C in the MTZ header.
C
LATTYP = SPGNAM(1:1)
C
C **********************************************************
CALL LWSYMM(MTZOUT,NSYM,NSYMP,RSYM,LATTYP,NUMSPG,SPGNAM,PGNAME)
C **********************************************************
C
C
C---- CALL to write Cell Parameters into the header common block
C
C
C **********************
CALL LWCELL(MTZOUT,CELL)
C **********************
RETURN
END
C
C== STATS ==
SUBROUTINE STATS(ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,BGRATIO,
+ PKRATIOS,NSBOX,IIM,FULL,OVRLFIT,NTHBIN)
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER ISPOT,ISDBSI,ISPOTPRO,ISIGPRO,NSBOX,IIM,NTHBIN
REAL BGRATIO,PKRATIOS
LOGICAL FULL,OVRLFIT
C ..
C .. Local Scalars ..
INTEGER K,IFREC,IP,IS
REAL DELEPS,PI,DELI,DELSIG,XIP,XIS,XSDP,XSDS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C ..
SAVE
C
PI = ATAN(1.0)*4.0
XIP = ISPOTPRO
XSDP = ISIGPRO
XIS = ISPOT
XSDS = ISDBSI
C
C---- I, sigma and I over sigma analysis as a function of resolution, separate
C statistics for summation integration and profile fitted intensities
C and for fulls and partials
C
IF (FULL) THEN
IRESPF(NTHBIN) = IRESPF(NTHBIN) + ISPOTPRO
IRESSF(NTHBIN) = IRESSF(NTHBIN) + ISPOT
ISDRESPF(NTHBIN) = ISDRESPF(NTHBIN) + ISIGPRO
ISDRESSF(NTHBIN) = ISDRESSF(NTHBIN) + ISDBSI
IF (NSBOX.NE.0) FIOVSDP(NTHBIN) = FIOVSDP(NTHBIN) + XIP/XSDP
FIOVSDS(NTHBIN) = FIOVSDS(NTHBIN) + XIS/XSDS
NRESPF(NTHBIN) = NRESPF(NTHBIN) + 1
NRESSF(NTHBIN) = NRESSF(NTHBIN) + 1
ELSE
IRESPP(NTHBIN) = IRESPP(NTHBIN) + ISPOTPRO
IRESSP(NTHBIN) = IRESSP(NTHBIN) + ISPOT
ISDRESPP(NTHBIN) = ISDRESPP(NTHBIN) + ISIGPRO
ISDRESSP(NTHBIN) = ISDRESSP(NTHBIN) + ISDBSI
IF (NSBOX.NE.0) PIOVSDP(NTHBIN) = PIOVSDP(NTHBIN) + XIP/XSDP
PIOVSDS(NTHBIN) = PIOVSDS(NTHBIN) + XIS/XSDS
NRESPP(NTHBIN) = NRESPP(NTHBIN) + 1
NRESSP(NTHBIN) = NRESSP(NTHBIN) + 1
END IF
DO 10 K = 1,9
IF (ISPOT.LT.IRANGE(K)) GO TO 20
10 CONTINUE
C
C
K = 10
20 AVSD(K) = AVSD(K) + ISDBSI
AVSDP(K) = AVSDP(K) + ISIGPRO
IANAL(K) = IANAL(K) + 1
RATIO(K) = RATIO(K) + BGRATIO
C
C
IF (FULL.AND.(.NOT.OVRLFIT)) THEN
IANALF(K) = IANALF(K) + 1
PKRATIO(K) = PKRATIO(K) + PKRATIOS
END IF
C
C---- Statistics on intensity vs partiality. If this is summed
C partial over images 2 and 3 of spot covering 3 images do
C not include it (flagged by IPART=-999 in PROCESS)
IF (IIM.EQ.-999) GOTO 30
DELEPS = ABS(0.01*IIM)
C
C---- Assume sinusoidal rocking curve
C
IFREC = (1-COS(DELEPS*PI))*100.0/2.0
IP = IFREC/5 + 1
IF (IP.GT.5) IP = IFREC/10 + 3
IF (IP.GT.12) IP = 12
C
C---- Trap fulls (IIM=0)
C
IF (IIM.EQ.0) IP = 13
NIVSM(IP) = NIVSM(IP) + 1
IVSM(IP) = IVSM(IP) + ISPOT
RSIGVSM(IP) = RSIGVSM(IP) + ISDBSI*ISDBSI
C
C
C---- now do statistics
C
C---- Statistics on comparison of profile fitted and integrated
C intensities and sigmas. done as a function of intensity
C (postscript 1) and box number (postscript 2)
C done separately for fully recorded and partials
C Return if no profile fitted intensities (flagged by NSBOX=0)
30 IF (NSBOX.EQ.0) RETURN
C
IS = 2
IF (FULL) IS = 1
DELI = ISPOT - ISPOTPRO
DELSIG = ISDBSI - ISIGPRO
AVINTI1(K,IS) = AVINTI1(K,IS) + ISPOT
AVINTI2(NSBOX,IS) = AVINTI2(NSBOX,IS) + ISPOT
AVPRI1(K,IS) = AVPRI1(K,IS) + ISPOTPRO
AVPRI2(NSBOX,IS) = AVPRI2(NSBOX,IS) + ISPOTPRO
RMSDELI1(K,IS) = RMSDELI1(K,IS) + DELI*DELI
RMSDELI2(NSBOX,IS) = RMSDELI2(NSBOX,IS) + DELI*DELI
ABSDELI1(K,IS) = ABSDELI1(K,IS) + ABS(DELI)
ABSDELI2(NSBOX,IS) = ABSDELI2(NSBOX,IS) + ABS(DELI)
MEANDELI1(K,IS) = MEANDELI1(K,IS) + DELI
MEANDELI2(NSBOX,IS) = MEANDELI2(NSBOX,IS) + DELI
AVSIG1(K,IS) = AVSIG1(K,IS) + ISDBSI
AVSIG2(NSBOX,IS) = AVSIG2(NSBOX,IS) + ISDBSI
AVPRSIG1(K,IS) = AVPRSIG1(K,IS) + ISIGPRO
AVPRSIG2(NSBOX,IS) = AVPRSIG2(NSBOX,IS) + ISIGPRO
AVDELSIG1(K,IS) = AVDELSIG1(K,IS) + ABS(DELSIG)
AVDELSIG2(NSBOX,IS) = AVDELSIG2(NSBOX,IS) + ABS(DELSIG)
NRFLS1(K,IS) = NRFLS1(K,IS) + 1
NRFLS2(NSBOX,IS) = NRFLS2(NSBOX,IS) + 1
END
C== STDPROF ==
SUBROUTINE STDPROF(OD,IRAS,MASK,IPROFL,SCALE,ODMIN)
C ===================================================
C
C
C---- Apply background correction to obtain standard profile
C for this box and scale to peak value 10000
C Evaluate and store sums for this profile in IPROFL
C Note that OD is background subtracted when returned from
C this S/R
C
C
C .. Scalar Arguments ..
REAL ODMIN,SCALE
C ..
C .. Array Arguments ..
INTEGER IRAS(5),MASK(*),OD(*),IPROFL(*)
C ..
C .. Local Scalars ..
REAL A,APC,B,C
INTEGER HX,HY,IJ,IOD,IODMAX,IODMIN,K,NBREJ,NXY,P,Q
C ..
C .. Intrinsic Functions ..
INTRINSIC MAX,MIN
C ..
C .. Common blocks ..
C&&*&& include ../inc/sums.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sums.h
C---- START of include file sums.h
C
C
C Elements of ASPOT
C 1 = Summation integration intensity
C 2 = Total background counts under peak assuming peak has mm symmetry
C 3 = Rms variation in background, after rejecting background points.
C This is evaluated in BGSOLVE called from EVAL.
C 4 = Centre of gravity in X direction (in pixels)
C 5 = Centre of gravity in Y direction (in pixels)
C These are wrt an origin at the centre of the measurement box
C 6 = sum p*iod for background pixels
C 7 = sum q*iod for background pixels
C 8 = sum iod for background pixels
C 9 = Background plane constant a (gradient in X direction)
C 10 = Background plane constant b (gradient in Y direction)
C 11 = Background plane constant c
C 12 = Largest deviation from background plane, excluding rejected pixels
C 13 = Profile fitted intensity
C 14 = Variance of profile fitted intensity = sum (deltasq) for peak
C pixels only. Used to calculate PKRATIO and also profile fitted
C sigma(I) in unweighted case only.
C 15 = Number of rejected background pixels
C 16 = Variance of profile fitted intensity in weighted case (default)
C 17 = sum W*DELTA**2 for profile fit
C 18 unused
C .. Arrays in common block /SUMS/ ..
REAL ASPOT
C ..
C .. Common Block /SUMS/ ..
COMMON /SUMS/ASPOT(18)
C ..
C
C
C&&*&& end_include ../inc/sums.f
C ..
C .. Equivalences ..
EQUIVALENCE (ASPOT(9),A), (ASPOT(10),B), (ASPOT(11),C)
C ..
C
SAVE
C
HX = IRAS(1)/2
HY = IRAS(2)/2
NXY = IRAS(1)*IRAS(2)
NBREJ = 0
IJ = 0
C
C
IODMIN = 999999
IODMAX = 0
C
C
DO 20 P = -HX,HX
APC = A*P + C
C
C
DO 10 Q = -HY,HY
IJ = IJ + 1
IOD = OD(IJ) - (B*Q+APC)
IODMIN = MIN(IODMIN,IOD)
C
C---- Limit max value to peak pixels
C
IF (MASK(IJ).EQ.1) IODMAX = MAX(IODMAX,IOD)
OD(IJ) = IOD
10 CONTINUE
20 CONTINUE
C
C---- Scale profile in range 0 to 10000
C
SCALE = 10000.0/ (IODMAX-IODMIN)
C
C
DO 30 K = 1,NXY
IOD = (OD(K)-IODMIN)*SCALE + 0.5
IPROFL(K) = IOD
30 CONTINUE
C
C
ODMIN = IODMIN
C
C
END
C
C
C
SUBROUTINE STKBCM(ISTAT)
C ========================
C
c Read next keyboard command & store in buffer
c
c On exit:
c istat = 0 string stored
c = +1 "go" or "exit" command stored
c = -1 blank string
c
IMPLICIT NONE
C
INTEGER ISTAT
C
CHARACTER*80 LINE
INTEGER XDLSTR
EXTERNAL XDLSTR
C
CALL XDLF_GETIO_STRING(XDLSTR(LINE), 80, ISTAT)
C istat = 1 for blank string, = 0 OK
IF (ISTAT .NE. 0) THEN
ISTAT = -1
RETURN
ELSE
c store string
CALL ADDKBB(LINE)
c Is this a "go" or "exit" command?
IF (LINE(1:2) .EQ. 'GO' .OR. LINE(1:4) .EQ. 'EXIT') THEN
c Set mark in buffer to this go command & reset read pointer to previous one
CALL STMKBB
ISTAT = +1
ELSE
ISTAT = 0
ENDIF
ENDIF
RETURN
END
C
C
C
SUBROUTINE STMKBB
C =================
c
c Set mark in keyboard buffer:
c 1. if mark set already, reset read pointer to old mark
c 2. set mark to write pointer - 1 (ie last line read)
c
IMPLICIT NONE
C
C&&*&& include ../inc/mxdkbb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdkbb.h
C---- START of include file mxdkbb.h
C
c
c********** mxdkbb *************
c
c Keyboard input buffer
c
c kbdbuf(0:maxkbb-1) rotating line buffer
c ip1kbb read pointer (= -1 is no lines to read)
c ip2kbb write pointer
c markbb mark point (= -1 if unset)
c
integer maxkbb
parameter (maxkbb = 10)
character*80 kbdbuf(0:maxkbb-1)
integer ip1kbb, ip2kbb, markbb
c
common /kbblin/ kbdbuf
common /kbbptr/ ip1kbb, ip2kbb, markbb
c
save /kbblin/, /kbbptr/
c
C&&*&& end_include ../inc/mxdkbb.f
C
IF (MARKBB .GE. 0) THEN
IP1KBB = MARKBB
ENDIF
MARKBB = IP2KBB - 1
IF (IP2KBB .LT. 0) IP2KBB = MAXKBB - 1
RETURN
END
C== STORSPOT ==
C
C
C
SUBROUTINE STORSPOT(IH,IFREC,IREASON,X,Y,PHI,PHIW,FRAC,IFLAG)
C ================================================================
C
C
IMPLICIT NONE
C
C
C IREASON = 0 Full spot
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot within cusp (set in subroutine REEK)
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C
C IFLAG = -1 if too many reflections to store (gt NREFLS)
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IFREC,IREASON,IFLAG
REAL X,Y,PHI,PHIW,FRAC
C ..
C .. Array Arguments ..
INTEGER IH(3)
C ..
C .. Local Scalars ..
INTEGER I,ISPOT
REAL XC,YC,FRACSP,PHISP,XINTSP
LOGICAL SPWRITE
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
EXTERNAL SHUTDOWN,MMTOPX,CCPDPN
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/pro.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file pro.h
C---- START of include file pro.h
C
C
C .. Arrays in common block /PRO/ ..
INTEGER*2 IDUM
C ..
C .. Common Block /PRO/ ..
COMMON /PRO/IDUM(MAXBUFF)
C ..
C
C
C&&*&& end_include ../inc/pro.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C ..
C .. Equivalences ..
C ..
SAVE
C
SPWRITE = .FALSE.
C
NSPOT = NSPOT + 1
C
C
IF (DEBUG(29) .AND. (NSPOT.LT.NDEBUG(29))) THEN
WRITE (IOUT,FMT=6000) NSPOT,IH,X,Y,IREASON,IFREC
IF (ONLINE) WRITE (ITOUT,FMT=6000) NSPOT,IH,X,Y,IREASON,
+ IFREC
END IF
C
C---- Check for maximum number of spots
C
IF (NSPOT.GT.NREFLS) THEN
IFLAG = -1
RETURN
ELSE
C
C---- Test spot list
C
IF (SPWRITE)
+ WRITE(6,*)0.01*X+100.0,0.01*Y+100.0,FRACSP,PHISP,XINTSP
XG(NSPOT) = X
YG(NSPOT) = Y
IF (DUMP(8)) THEN
FRACSP = 0.5
PHISP = 0.5*(PHIBEG+PHIEND)
XINTSP = 10000
ISPOT = 10
CALL MMTOPX(XC,YC,X,Y)
XC = XC*0.01
YC = YC*0.01
IF (INVERTX) XC = NREC*RAST - XC
WRITE(ISPOT,FMT=6010)XC,YC,FRACSP,PHISP,XINTSP
6010 FORMAT(1X,4F8.3,F10.1)
END IF
IRG(NSPOT) = IREASON
IMG(NSPOT) = IFREC
PHIG(NSPOT) = PHI
PHIWG(NSPOT) = PHIW
FRACG(NSPOT) = FRAC
C
C---- Must set MISYMG to zero, otherwise in an interactive session if
C an image has been integrated MISYMG will have non-zero values
C and after a prediction GETINDX will return the wrong indices
C
MISYMG(NSPOT) = 0
DO 8 I = 1,3
IF (ABS(IH(I)).GT.1000) THEN
WRITE(IOUT,FMT=6001)
IF (ONLINE) WRITE(ITOUT,FMT=6001)
IF (BRIEF) WRITE(IBRIEF,FMT=6001)
6001 FORMAT(/,1X,'*** FATAL ERROR ***'/,1X,'Cannot store',
+ ' indices greater than 1000')
CALL SHUTDOWN
END IF
8 CONTINUE
C
C---- Store indices
C
IHG(NSPOT) = IH(1)
IKG(NSPOT) = IH(2)
ILG(NSPOT) = IH(3)
C
C---- Flag zero level reflections for display in FLMPLOT
C
CAL IF (IH(JUMPAX).EQ.0) IGFLAG(NSPOT) = 10
END IF
C
C---- Format statements
C
6000 FORMAT (1X,'REEKE...NSPOT=',I5,' H,K,L',3I5,' IX,IY',2F13.6,
+ ' IR,','IM',2I4)
C
C
END
C
SUBROUTINE STRIPSTR(STR,NCH)
C ==========================
C
C---- STR is a string containing a number in integer or real format.
C STR is returned with leading blanks removed.
C NCH is returned as number of non-blank characters in STR
C
IMPLICIT NONE
C
C
C .. Scalar Arguments ..
CHARACTER*(*) STR
INTEGER NCH
C
C ..
C .. Local Scalars ..
INTEGER NCHTOT,IST,I
C ..
C .. Local Arrays ..
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C ..
C .. Extrinsic Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
NCHTOT = LENSTR(STR)
DO 10 I = 1,NCHTOT
IF (STR(I:I).NE.' ') THEN
IST = I
GOTO 20
END IF
10 CONTINUE
C
IST = 1
20 NCH = NCHTOT-IST+1
STR(1:NCH) = STR(IST:NCHTOT)
IF (NCH.LT.NCHTOT) STR(NCH+1:NCHTOT) = ' '
RETURN
END
C== SUMMERR ==
SUBROUTINE SUMMERR(ISUMMR,ID,NERR,NFP,NFGEN,FILM,IX,X)
C ======================================================
C
C
C---- Writes error message to summary file
C Last modified 1/8/91
C
C
C
C
C .. Scalar Arguments ..
REAL X
INTEGER FILM,ID,ISUMMR,IX,NERR,NFGEN,NFP
C ..
C .. Local Scalars ..
INTEGER I,IFILM,NLEFT
C ..
C .. Local Arrays ..
CHARACTER ABC(3)*1
C ..
C .. Common blocks ..
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C ..
C .. Data statements ..
DATA ABC/'A','B','C'/
C ..
C
C
IF (NFP.EQ.0) NFP = NFGEN
C
C---- Eliminate film identifier for image plates
C
IF (IMGP) ABC(1) = ' '
C
IF (NERR.EQ.1) THEN
WRITE (ISUMMR,FMT=6000) ID,ABC(FILM)
6000 FORMAT (1X,I5,A,10X,'*** Pack not in generate file ***')
ELSE IF (NERR.EQ.2) THEN
WRITE (ISUMMR,FMT=6002) ID,ABC(FILM)
6002 FORMAT (1X,I5,A,10X,'*** Previous film in pack not measured ***')
ELSE IF (NERR.EQ.3) THEN
WRITE (ISUMMR,FMT=6004) ID,ABC(FILM)
6004 FORMAT (1X,I5,A,10X,'*** No image file for this pack ***')
ELSE IF (NERR.EQ.4) THEN
WRITE (ISUMMR,FMT=6006) ID,ABC(FILM),IX
6006 FORMAT (1X,I5,A,10X,'*** Only ',I2,' Fiducials found ***')
ELSE IF (NERR.EQ.5) THEN
WRITE (ISUMMR,FMT=6008) ID,ABC(FILM),IX
6008 FORMAT (1X,I5,A,10X,'*** Only ',I3,' Reflections found for refin',
+ 'ement of central film region ***')
ELSE IF (NERR.EQ.6) THEN
WRITE (ISUMMR,FMT=6010) ID,ABC(FILM),X
6010 FORMAT (1X,I5,A,10X,'*** Residual in centre of film too HIGH (',
+ F5.1,') ***')
ELSE IF (NERR.EQ.7) THEN
WRITE (ISUMMR,FMT=6012) ID,ABC(FILM)
6012 FORMAT (1X,I5,A,10X,'*** Too few reflections found For refinemen',
+ 't of film ***')
ELSE IF (NERR.EQ.8) THEN
WRITE (ISUMMR,FMT=6014) ID,ABC(FILM),X
6014 FORMAT (1X,I5,A,10X,'*** Residual over whole film too HIGH (',
+ F5.1,') ***')
ELSE IF (NERR.EQ.9) THEN
WRITE (ISUMMR,FMT=6016) ID,ABC(FILM)
6016 FORMAT (1X,I5,A,10X,'*** Too many reflections in generate FILE *',
+ '**')
ELSE
WRITE (ISUMMR,FMT=6018) ID,ABC(FILM)
6018 FORMAT (1X,I5,A,10X,'*** Unspecified error in processing FILM ***'
+ )
END IF
C
C---- See how many more films in this pack to be processed
C
NLEFT = NFP - FILM
C
C
IF (NLEFT.NE.0) THEN
IFILM = FILM
C
C
DO 10 I = 1,NLEFT
IFILM = IFILM + 1
WRITE (ISUMMR,FMT=6020) ID,ABC(IFILM)
6020 FORMAT (1X,I5,A,10X,'*** Film not processed ***')
10 CONTINUE
C
C
END IF
END
C== SURMP ==
SUBROUTINE SURMP(A,B)
C =====================
C
C---- Set up matrix B for rotation of A about z axis.
C ie B is set to
C
C ( COS(A) -SIN(A) 0 )
C ( SIN(A) COS(A) 0 )
C ( 0 0 1 )
C
C
C
C
C .. Scalar Arguments ..
REAL A
C ..
C .. Array Arguments ..
REAL B(3,3)
C ..
C .. Local Scalars ..
REAL CZ,SZ
C ..
C .. Intrinsic Functions ..
INTRINSIC COS,SIN
C ..
C
C
CZ = COS(A)
SZ = SIN(A)
B(1,1) = CZ
B(1,2) = -SZ
B(1,3) = 0.0
B(2,1) = SZ
B(2,2) = CZ
B(2,3) = 0.0
B(3,1) = 0.0
B(3,2) = 0.0
B(3,3) = 1.0
C
C
END
C== SWAPHDR ==
SUBROUTINE SWAPHDR(IHEAD,NITEM)
C
IMPLICIT NONE
C Swap the byte order for the first NITEM words (4 byte) in IHEAD
C ..
C .. Scalar Arguments ..
INTEGER NITEM
C ..
C .. Array Arguments ..
BYTE IHEAD(NITEM*4)
C ..
C .. Local Scalars ..
INTEGER I,J,IPT
C ..
C .. Local Arrays ..
BYTE ITEMP(4)
C
DO 10 I = 1,NITEM
IPT = (I-1)*4
DO 20 J = 1,4
ITEMP(J) = IHEAD(IPT+J)
20 CONTINUE
DO 30 J = 1,4
IHEAD(IPT+J) = ITEMP(5-J)
30 CONTINUE
10 CONTINUE
RETURN
END
C== SWITCH ==
C
C
C
SUBROUTINE SWITCH(R1,R2)
C =======================
C
C---- Switches two numbers
C
C
C
C .. Scalar Arguments ..
REAL R1,R2
C ..
C .. Local Scalars ..
REAL DUM
C ..
C
C
DUM = R1
R1 = R2
R2 = DUM
C
C
END
SUBROUTINE TARGMAT(AMAT,TMAT,TARCELL)
C ===============================
C
IMPLICIT NONE
C
C
C .. Parameters ..
C
C ..
C .. Scalar Arguments ..
C
C ..
C .. Array Arguments ..
REAL AMAT(3,3),TMAT(3,3),TARCELL(6)
C ..
C .. Local Scalars ..
INTEGER I,J
C ..
C .. Local Arrays ..
REAL ASTV(3),BSTV(3),CSTV(3)
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL RTUMAT
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C
INTEGER IGROUP,FIXF
REAL FLAMBDA,F,THRESH,Q,DPHI,ORGX,ORGY,CCX,CCY,CCOM,DXY
LOGICAL TARGET,DCOMP,LCAMC,FILM,FIXCELL
REAL RFCELL(6),ED(3,3),ACHSE(3),S0(3),TARMAT(3,3)
COMMON /REFCOM/IGROUP,FLAMBDA,RFCELL,F,THRESH,Q,DPHI,ED,
+ ACHSE,S0,ORGX,ORGY,FIXF,TARMAT,TARGET,DCOMP,
+ LCAMC,CCX,CCY,CCOM,FILM,DXY,FIXCELL
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
DO 4 I = 1,3
DO 2 J = 1,3
TARMAT(I,J) = TMAT(I,J)
2 CONTINUE
4 CONTINUE
DO 6 I = 1,3
ASTV(I) = AMAT(I,1)
BSTV(I) = AMAT(I,2)
CSTV(I) = AMAT(I,3)
6 CONTINUE
C
DO 10 I = 1,6
RFCELL(I) = TARCELL(I)
10 CONTINUE
DCOMP = .TRUE.
FLAMBDA = WAVE
C
C---- For this purpose we need to find the Laue operators that reflect
C the symmetry of the lattice, rather than the space-group. Thus we
C need to modify the "space group number" passed to RTUMAT for trigonal,
C tetragonal, hexagonal and cubic space-groups.
C
IGROUP = NUMSPG
C
C---- Tetragonal
C
IF ((IGROUP.GE.75).AND.(IGROUP.LE.142)) IGROUP = 142
C
C---- Trigonal or hexagonal
C
IF ((IGROUP.GE.143).AND.(IGROUP.LE.194)) IGROUP = 194
C
C---- Cubic
C
IF (IGROUP.GE.195) IGROUP = 230
C
CALL RTUMAT(ASTV,BSTV,CSTV)
C
C---- Pass back the A-matrix
C
DO 20 I = 1,3
AMAT(I,1) = ASTV(I)
AMAT(I,2) = BSTV(I)
AMAT(I,3) = CSTV(I)
20 CONTINUE
DCOMP = .FALSE.
END
C== TDATE ==
C
C
C
C
C
SUBROUTINE TDATE
C ================
C
C
C
C
C .. Local Scalars ..
INTEGER J
CHARACTER ITIME*8
C ..
C .. Local Arrays ..
INTEGER JDATE(3)
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
SAVE
C
C
C **********************************
CALL UIDATE(JDATE(2),JDATE(1),JDATE(3))
CALL UTIME(ITIME)
C **********************************
C
WRITE (IOUT,FMT=6000) (ITIME), (JDATE(J),J=1,3)
IF (ONLINE) WRITE (ITOUT,FMT=6000) (ITIME), (JDATE(J),J=1,3)
C
C---- Format statments
C
6000 FORMAT (' OUTPUT FROM MOSFLM AT ',A8,' ON ',I2,'/',I2,'/',I2,'.',
+ //)
C
C
END
SUBROUTINE TEMPLMAKE(TEMPLSTART,TEMPLEND,NTDIG,ID,ODFILE,IFLAG)
C ==============================================================
C
C---- set up image filename using the components of the TEMPLATE
C
C TEMPLSTART first string of template, prior to image number (input)
C TEMPLEND end string of template, following image number (input)
C NTDIG Number of digits in image number (input)
C ID Image number (input)
C ODFILE Image filename (returned)
C IFLAG Error flag, non-zero if error in assigning ODFILE
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C ..
C .. Scalar Arguments ..
CHARACTER*(*) TEMPLSTART,TEMPLEND,ODFILE
INTEGER NTDIG,ID,IFLAG
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,J,K,NCH
CHARACTER STR*20
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
IFLAG = 0
IF (NTDIG.EQ.1) THEN
C
C---- Single digit is also used when image number is not padded by zeros.
C
IF (ID.LE.9) THEN
WRITE(STR,6100) ID
ELSE IF (ID.LE.99) THEN
WRITE(STR,6102) ID
ELSE IF (ID.LE.999) THEN
WRITE(STR,6104) ID
ELSE IF (ID.LE.9999) THEN
WRITE(STR,6106) ID
ELSE IF (ID.LE.99999) THEN
WRITE(STR,6108) ID
ELSE IF (ID.LE.999999) THEN
WRITE(STR,6110) ID
ELSE IF (ID.LE.9999999) THEN
WRITE(STR,6112) ID
ELSE IF (ID.LE.99999999) THEN
WRITE(STR,6114) ID
ELSE IF (ID.LE.999999999) THEN
WRITE(STR,6116) ID
ELSE
IFLAG = 1
RETURN
END IF
6100 FORMAT(I1)
6102 FORMAT(I2)
6104 FORMAT(I3)
6106 FORMAT(I4)
6108 FORMAT(I5)
6110 FORMAT(I6)
6112 FORMAT(I7)
6114 FORMAT(I8)
6116 FORMAT(I9)
C
ELSE IF (NTDIG.EQ.2) THEN
IF (ID.GT.99) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6002) ID
ELSE IF (NTDIG.EQ.3) THEN
IF (ID.GT.999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6004) ID
ELSE IF (NTDIG.EQ.4) THEN
IF (ID.GT.9999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6006) ID
ELSE IF (NTDIG.EQ.5) THEN
IF (ID.GT.99999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6008) ID
ELSE IF (NTDIG.EQ.6) THEN
IF (ID.GT.999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6010) ID
ELSE IF (NTDIG.EQ.7) THEN
IF (ID.GT.9999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6012) ID
ELSE IF (NTDIG.EQ.8) THEN
IF (ID.GT.99999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6014) ID
ELSE IF (NTDIG.EQ.9) THEN
IF (ID.GT.999999999) THEN
IFLAG = 1
RETURN
END IF
WRITE(STR,6016) ID
END IF
NCH = LENSTR(TEMPLSTART)
IF (NCH.GT.0) THEN
ODFILE = TEMPLSTART(1:NCH)//STR(1:LENSTR(STR))
END IF
NCH = LENSTR(TEMPLEND)
IF (NCH.GT.0) THEN
ODFILE = ODFILE(1:LENSTR(ODFILE))//TEMPLEND(1:NCH)
END IF
RETURN
6000 FORMAT(I1.1)
6002 FORMAT(I2.2)
6004 FORMAT(I3.3)
6006 FORMAT(I4.4)
6008 FORMAT(I5.5)
6010 FORMAT(I6.6)
6012 FORMAT(I7.7)
6014 FORMAT(I8.8)
6016 FORMAT(I9.9)
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE TEMPLREAD(STR,TEMPLSTART,TEMPLEND,NTDIG)
C ===================================================
C
C---- Extract the components of the TEMPLATE used to set up image filenames
C
C STR input template set by TEMPLATE keyword (input)
C TEMPLSTART first string of template, prior to image number (returned)
C TEMPLEND end string of template, following image number (ret)
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. (returned).
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C
C ..
C .. Scalar Arguments ..
CHARACTER*(*) STR,TEMPLSTART,TEMPLEND
INTEGER NTDIG
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,J,K,NCH,ISTART
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
ISTART = -1
NTDIG = 0
TEMPLSTART = ' '
TEMPLEND = ' '
NCH = LENSTR(STR)
DO 10 I = 1,NCH
IF (STR(I:I).EQ.'#') THEN
IF (ISTART.EQ.-1) THEN
C
C---- First occurence of a #
C
ISTART = I-1
IF (ISTART.GT.0) TEMPLSTART = STR(1:ISTART)
ELSE
C
C---- Continuation OF #, check previous character
C
IF (STR(I-1:I-1).NE.'#') THEN
NTDIG = 0
RETURN
END IF
END IF
NTDIG = NTDIG + 1
END IF
10 CONTINUE
IF (NTDIG.EQ.0) RETURN
IF (ISTART+NTDIG.LT.NCH) TEMPLEND = STR(ISTART+NTDIG+1:NCH)
RETURN
END
C== TESTOVER ==
C
SUBROUTINE TESTOVER
IMPLICIT NONE
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C---- Calculates and tabulates the number of overlaps for a series of
C different oscillation angles over a specified total oscillation
C range, for option testgen
C
C ..
C .. Local Scalars ..
REAL ANGLE,DX,DY,ROT,XAXIS,YAXIS,YMIN,DTR,DELR,THETA,T,
+ RPLUS,THPLUS,SX,CX,SY,CY,PHI,OSC,OSCINC,FRAC,PHI1,PHI2,
+ FRACOLD,FRACFULL,FRACFULLOLD,MINSPLIT
INTEGER I,IPACK,J,K,NANGLE,IPLOT,IPHI,IPHSTART,IPHEND,IPHSTEP,
+ NSTEP,IPART,MODERK,IIEND,XMLLENGTH
LOGICAL OSCINCR,OSCDECR,FIXANG
CHARACTER*80 LINE
CHARACTER*4096 xmlline
C ..
C .. Local Arrays
INTEGER*2 ITEMP(1)
REAL OSCBEST(300),FRACBEST(300),FULLBEST(300)
C ..
C .. External Subroutines ..
EXTERNAL PRINTSTATS,PRINTTEST,REEK,OVERLAP,XDLF_FLUSH_EVENTS
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. Intrinsic Functions ..
INTRINSIC NINT
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/iosp.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file iosp.h
C---- START of include file iosp.h
C
C
C .. Scalars in common block /IOSP/ ..
INTEGER NSPOT,NFULL,NOUTGEN
C ..
C .. Common Block /IOSP/ ..
COMMON /IOSP/NSPOT,NFULL,NOUTGEN
C ..
C
C
C&&*&& end_include ../inc/iosp.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/tgen.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file tgen.h
C---- START of include file tgen.h
C
C---- Stores variables for use in TESTGEN option
C
C .. Arrays in common /TGEN/ ..
c REAL XOVER
c INTEGER ISTATS
C
C .. Scalars in common /TGEN/ ..
REAL XOVER,PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,SDIVH,SDIVV,
+ SDELCOR,SDELAMB,SETA,OSCANG,PCMAX
INTEGER ISTATS
LOGICAL TESTGEN,TESTRAT
C ..
C ..
C .. Common Block /TGEN/ ..
COMMON /TGEN/XOVER(2),PHSTART,PHEND,PHSTEP,OSCMIN,OSCMAX,
+ SDIVH,SDIVV,SDELCOR,SDELAMB,SETA,OSCANG,PCMAX,
$ ISTATS(MAXPAX,3),TESTGEN,TESTRAT
C&&*&& end_include ../inc/tgen.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
SAVE
C
IF(TESTRAT.AND.(IXSEP.EQ.0).and.(iysep.eq.0))THEN
C
C--- rough calculation of minimum spot separation on image
C
IF(RCELL(1).LT.RCELL(2))THEN
MINSPLIT=RCELL(1)
ELSE
IF (RCELL(2).LT.RCELL(3))THEN
MINSPLIT = RCELL(2)
ELSE
MINSPLIT = RCELL(3)
ENDIF
ENDIF
IXSEP = INT(WAVE*XTOFD*MINSPLIT/5.0)
IYSEP = IXSEP
ENDIF
C
C---- Set flag for only one oscillation angle to be tried
C
FIXANG = (OSCANG.NE.0.0)
C
IF (.NOT.FIXANG) THEN
WRITE (IOUT,FMT=6000) PHSTART,PHEND,PHSTEP,XOVER(1),
+ OSCMIN,OSCMAX
IF (ONLINE) WRITE (ITOUT,FMT=6000) PHSTART,PHEND,PHSTEP,
+ XOVER(1),OSCMIN,OSCMAX
6000 FORMAT (///1X,'TESTGEN OPTION',/1X,'==============',/,1X,
+ 'Generating from phi =',F7.2,' (START) to ',F6.2,' (END)',
+ ' testing overlaps',/,1X,'every',F6.2,' degrees (STEP).',
+ /,1X,'At each phi value, the oscillation angle which ',
+ 'results in less than',/,1X,F5.1,
+ '% overlaps (OVERLAP) ',
+ 'will be determined, subject to a minimum oscillation',
+ /,1X,'angle of',F5.2,' degrees (MINOSC) and a ',
+ 'maximum of',F6.2,' (MAXOSC)')
IF ((IXSEP.EQ.0).OR.(IYSEP.EQ.0)) THEN
WRITE(IOUT,FMT=6001) 0.01*IXSEP,0.01*IYSEP
IF (ONLINE) WRITE(ITOUT,FMT=6001) 0.01*IXSEP,0.01*IYSEP
6001 FORMAT(1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,
+ 1X,'***** WARNING *****',/,1X,
+ 'Current values for minimum spot separation are not',
+ ' reasonable',/,1X,'Values are:',2F6.2,'mm',/,1X,
+ 'Use the SEPARATION keyword to define sensible values.')
RETURN
END IF
IF (WINOPEN) THEN
LINE = 'TESTGEN OPTION'
CALL MXDWIO(LINE,3)
WRITE(LINE,FMT=6070) PHSTART,PHEND
6070 FORMAT('Generating from phi =',F7.2,' (START) to ',F6.2,
+ ' (END)')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6072) PHSTEP
6072 FORMAT('testing overlaps every',F6.2,
+ ' degrees (STEP).')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6074)
6074 FORMAT('At each phi value, the oscillation angle which ',
+ 'results in less than')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6076) XOVER(1)
6076 FORMAT(F5.1,'% overlaps (OVERLAP) ',
+ 'will be determined, subject to a minimum')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6078) OSCMIN,OSCMAX
6078 FORMAT('oscillation angle of',F5.2,' degrees (MINOSC) and',
+ ' a maximum of',F6.2,' (MAXOSC)')
CALL MXDWIO(LINE,2)
END IF
ELSE
WRITE(IOUT,FMT=6002) PHSTART,PHEND,PHSTEP,OSCANG
IF (ONLINE) WRITE(ITOUT,FMT=6002) PHSTART,PHEND,PHSTEP,OSCANG
IF (WINOPEN) THEN
LINE = 'TESTGEN OPTION'
CALL MXDWIO(LINE,3)
WRITE(LINE,FMT=6080) PHSTART,PHEND
6080 FORMAT('Generating from phi =',F7.2,' (START) to ',
+ F6.2,' (END)',' calculating overlaps')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6082)PHSTEP,OSCANG
6082 FORMAT('every',F6.2,' degrees (STEP)',
+ ' for an oscillation angle of',F5.2,' degrees.')
CALL MXDWIO(LINE,2)
END IF
END IF
DTR = ATAN(1.0)*4.0/180.0
6002 FORMAT (///1X,'TESTGEN OPTION',/1X,'==============',/,1X,
+ 'Generating from phi =',F7.2,' (START) to ',F6.2,' (END)',
+ ' calculating overlaps',/,1X,'every',F6.2,' degrees (STEP)',
+ ' for an oscillation angle of',F5.2,' degrees')
SCNSZ = 40.0*RAST
FACT = 0.4/SCNSZ
C
C---- Calculate the reciprocal sphere radius DSTPL - corresponding to
C a slightly higher resolution to be used in checking overlaps
C on the outside of the picture
C
DELR = MAX(MINDTX,MINDTY)*2.0
THETA = ASIN(DSTMAX/2.0)
T = TAN(2.0*THETA)
C
C
C
IF (VEE) THEN
C
C---- Vee cassette
C
RPLUS = 2.0*XTOFD*T/ (SQRT(3.0)+T) + DELR
THPLUS = ATAN(SQRT(3.0)/ (2.0*XTOFD/RPLUS-1.0))*0.5
ELSE
C
C---- Flat cassette
C
RPLUS = XTOFD*T + DELR
THPLUS = ATAN(RPLUS/XTOFD)*0.5
END IF
C
C
DSTPL = SIN(THPLUS)*2.0
DSTPL2 = DSTPL*DSTPL
C
C---- Initialise RMC matrix - for the X and Y missetting angles.
C Rotation about x and then y
C RMC = PHIY . PHIX
C
SX = SIN(DELPHI(1)*DTR)
SY = SIN(DELPHI(2)*DTR)
CX = COS(DELPHI(1)*DTR)
CY = COS(DELPHI(2)*DTR)
C
RMC(1,1) = CY
RMC(1,2) = SX*SY
RMC(1,3) = CX*SY
RMC(2,1) = 0.0
RMC(2,2) = CX
RMC(2,3) = -SX
RMC(3,1) = -SY
RMC(3,2) = SX*CY
RMC(3,3) = CX*CY
C
C---- Fisrt call REEK with a very small oscillation to get array IAX giving
C orientation of axes set up
C
PHIBEG = PHSTART
PHIEND = PHIBEG + 0.05
ITEMP(1) = 0
MODERK = 0
C ******************
CALL REEK(ITEMP(1),MODERK)
C ******************
C
C IAX(3) r.l. axis most nearly parallel/antiparallel to Z
C (along rotation axis away from spindle)
C
C IAX(1) remaining r.l. axis most nearly parallel/antiparallel
C to X (along xray beam)
C
C IAX(2) remaining r.l. axis
C
C
C----- Estimate oscillation angle as RES/cell_along_x
C
OSC = WAVE/(DSTMAX*CELL(IAX(1)))
OSC = OSC/DTR
OSC = 0.1*NINT(10.0*OSC)
IF (OSC.GT.OSCMAX) OSC = OSCMAX
IF (OSC.LT.OSCMIN) OSC = OSCMIN
OSCINC = 0.1*(NINT(10.0*OSC)/10)
IF (OSCINC.EQ.0) OSCINC = 0.1
C
C---- If osc angle 0.5 or less, allow increments of 0.05
C
IF (OSC.LE.0.5) OSCINC = 0.1*(NINT(20.0*OSC)/20)
IF (FIXANG) OSC = OSCANG
IF (DEBUG(56)) THEN
WRITE(IOUT,FMT=6030) OSC,OSCINC,IAX,DSTMAX/WAVE
IF (ONLINE) WRITE(ITOUT,FMT=6030) OSC,OSCINC,IAX,DSTMAX/WAVE
6030 FORMAT(1X,'Initial estimate of osc angle',F6.3,' increment',
+ F6.3,' IAX',3I2,' DSTMAX',F8.4,' WAVE',F6.4)
END IF
IPACK = 1
C
C---- Loop over phi range
C
IPHSTART = NINT(PHSTART)
IPHSTEP = NINT(PHSTEP)
NSTEP = NINT((PHEND-PHSTART)/PHSTEP)
IPHEND = IPHSTART + NSTEP*IPHSTEP
IPART = 0
DO 20 IPHI = IPHSTART,IPHEND,IPHSTEP
IF (ONLINE.AND.(.NOT.FIXANG)) WRITE(ITOUT,FMT=6032) IPHI
6032 FORMAT(1X,'Testing at phi',I4,' degrees')
IF (WINOPEN.AND.(.NOT.FIXANG)) THEN
WRITE(LINE,FMT=6100) IPHI
6100 FORMAT('Testing at phi',I4,' degrees')
CALL MXDWIO(LINE,2)
END IF
IPART = IPART + 1
IF (IPART.GT.300) THEN
WRITE(IOUT,FMT=6050)
IF (ONLINE) WRITE(ITOUT,FMT=6050)
6050 FORMAT(1X,'Too many tests (Max 300). Either decrease',
+ ' the phi range or increase the phi step')
IF (WINOPEN) THEN
LINE = '** ERROR ** See terminal window'
CALL MXDWIO(LINE,2)
END IF
NSPOT = 0
RETURN
END IF
OSCINCR = .FALSE.
OSCDECR = .FALSE.
C
22 NSPOT = 0
PHIBEG = REAL(IPHI)
PHIEND = PHIBEG + OSC
C
C *****
ITEMP(1) = 0
MODERK = 2
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
CALL REEK(ITEMP(1),MODERK)
C
C---- Test for too many reflections generated
C
IF (MODERK.EQ.-2) THEN
WRITE(IOUT,FMT=6033) OSC,NREFLS
IF (ONLINE) WRITE(ITOUT,FMT=6033) OSC,NREFLS
6033 FORMAT(//1X,'*** ERROR ***',/,1X,'In testing an ',
+ 'oscillation angle of',F7.2,' more than',I6,/,1X,
+ 'reflections would need to be generated.',/,1X,'If you ',
+ 'really need to test this many reflections change ',
+ 'the',/,1X,'parameter NREFLS with a global edit and',
+ ' recompile the program.',/1X,'Otherwise, limit the',
+ ' maximum angle to be tested with keyword MAXOSC',/1X,
+ 'eg TESTGEN START 0 END 60 OVERLAP 5 MAXOSC 4')
IF (WINOPEN) THEN
LINE = '** ERROR ** See terminal window'
CALL MXDWIO(LINE,2)
END IF
NSPOT = 0
RETURN
END IF
C
C *****
C
C---- Check for overlapping reflexions
C
C *******
CALL OVERLAP
C *******
C
C ******************
CALL PRINTSTATS(IPACK)
C ******************
C---- See if this is acceptable
C
FRAC = 100.0*REAL(ISTATS(IPACK,3))/REAL(ISTATS(IPACK,1))
FRACFULL = 100.0*REAL(ISTATS(IPACK,2))/REAL(ISTATS(IPACK,1))
IF (DEBUG(56)) THEN
WRITE(IOUT,FMT=6034) PHIBEG,PHIEND,(ISTATS(IPACK,J),J=1,3),
+ FRAC
IF (ONLINE) WRITE(ITOUT,FMT=6034) PHIBEG,PHIEND,
+ (ISTATS(IPACK,J),J=1,3),FRAC
6034 FORMAT(1X,'Phi start',F7.2,' end',F7.2,' Total',I6,
+ ' : ',I6,' fulls',I4,' overlaps (',F4.1,
+ '%)')
END IF
C
C---- Do not try other oscillation angles if testing a given angle
C
IF (FIXANG) THEN
WRITE(IOUT,FMT=6034) PHIBEG,PHIEND,(ISTATS(IPACK,J),J=1,3),
+ FRAC
IF (ONLINE) WRITE(ITOUT,FMT=6034) PHIBEG,PHIEND,
+ (ISTATS(IPACK,J),J=1,3),FRAC
IF (WINOPEN) THEN
WRITE(LINE,FMT=6102) PHIBEG,PHIEND,
+ (ISTATS(IPACK,J),J=1,3),FRAC
6102 FORMAT('Phi start',F7.2,' end',F7.2,' Total',I6,
+ ' : ',I6,' fulls',I4,' overlaps (',F4.1,
+ '%)')
CALL MXDWIO(LINE,2)
END IF
OSCBEST(IPART) = OSC
FRACBEST(IPART) = FRACOLD
FULLBEST(IPART) = FRACFULLOLD
GOTO 20
END IF
IF (FRAC.GT.XOVER(1)) THEN
IF (OSCINCR) THEN
OSC = OSC - OSCINC
OSCBEST(IPART) = OSC
FRACBEST(IPART) = FRACOLD
FULLBEST(IPART) = FRACFULLOLD
GOTO 20
END IF
IF (OSC.LE.0.5) THEN
OSCINC = 0.05
ELSE
OSCINC = 0.1*(NINT(10.0*OSC)/10)
IF (OSCINC.EQ.0) OSCINC = 0.1
END IF
OSC = OSC - OSCINC
OSCDECR = .TRUE.
FRACOLD = FRAC
IF (OSC.GE.OSCMIN) GOTO 22
C
C---- Trap possible rounding error avoiding min osc angle
C
IF (ABS(OSC-OSCMIN).LT.0.01) GOTO 22
C
C---- Cannot get few enough overlaps
C
OSC = OSCMIN
PHI = REAL(IPHI)
WRITE(IOUT,FMT=6040) PHI,FRAC,OSCMIN
IF (ONLINE) WRITE(ITOUT,FMT=6040) PHI,FRAC,OSCMIN
6040 FORMAT(1X,'For phi=',F6.1,' the minimum percentage ',
+ 'overlaps is',F5.1,'% for an oscillation',
+ ' angle above',F6.2,/,1X,
+ 'Either change the minimum allowed oscillation',
+ ' angle ( MINOSC) or increase the allowable',
+ ' overlap (OVER)')
IF (WINOPEN) THEN
LINE = ' '
WRITE(LINE,FMT=6104 )PHI,FRAC
6104 FORMAT('For phi=',F6.1,' the minimum percentage ',
+ 'overlaps is',F5.1,'% for an oscillation')
CALL MXDWIO(LINE,2)
LINE = ' '
WRITE(LINE,FMT=6105) OSCMIN
6105 FORMAT('angle above',F6.2)
CALL MXDWIO(LINE,2)
LINE = ' '
WRITE(LINE,FMT=6106)
6106 FORMAT('Either change the minimum allowed oscillation',
+ ' angle (MINOSC) or increase')
6107 FORMAT('allowed overlap (OVER)')
CALL MXDWIO(LINE,2)
END IF
OSCBEST(IPART) = OSCMIN
ELSE IF (FRAC.LE.XOVER(1)) THEN
IF (OSCDECR) THEN
OSCBEST(IPART) = OSC
FRACBEST(IPART) = FRAC
FULLBEST(IPART) = FRACFULL
GOTO 20
END IF
IF (OSC.LT.0.5) THEN
OSCINC = 0.05
ELSE
OSCINC = 0.1*(NINT(10.0*OSC)/10)
IF (OSCINC.EQ.0) OSCINC = 0.1
END IF
OSC = OSC + OSCINC
IF (OSC.GT.OSCMAX) THEN
OSC = OSC - OSCINC
OSCBEST(IPART) = OSC
FRACBEST(IPART) = FRAC
FULLBEST(IPART) = FRACFULL
GOTO 20
END IF
OSCINCR = .TRUE.
FRACOLD = FRAC
FRACFULLOLD = FRACFULL
GOTO 22
END IF
C
20 CONTINUE
C
C
C---- Now work out the various segments required (not if using a fixed angle)
C
IF (FIXANG) GOTO 40
C
WRITE(IOUT,FMT=6060) XOVER(1)
IF (ONLINE) WRITE(ITOUT,FMT=6060) XOVER(1)
6060 FORMAT(/,1X,'Suggested data collection stratgey for a maximum',
+ ' spot overlap of',F5.1,'%',//,1X,'Phi start ',
+ 'Phi end no of images oscillation angle %age',
+ ' overlaps %age fulls')
IF (WINOPEN) THEN
WRITE(LINE,6110) XOVER(1)
6110 FORMAT('Suggested data collection stratgey for a maximum',
+ ' spot overlap of',F5.1,'%')
CALL MXDWIO(LINE,3)
WRITE(LINE,6112)
6112 FORMAT('Phi start ',
+ 'Phi end no of images oscillation angle %age',
+ ' overlaps %age fulls')
CALL MXDWIO(LINE,3)
END IF
IPART = 0
PHI1 = PHSTART
IIEND = IPHEND-IPHSTEP
IIEND = MAX(IIEND,IPHSTART)
if(socklo) then
c god! this stuff is horrible!
c write(xmlline, fmt=8061) PCMAX
c xmllength = lenstr(xmlline)
c 8061 format('',
c $ 'ok',
c $ '', f6.1, '',
c $ '')
c call write_socket_section(serverfd, xmllength, xmlline)
c trying this with some happy dna xml.
c it's the new style
6254 format('',
$ 'ok',
$ '',
$ '', F4.1, '',
$ '')
6255 format('',
$ 'ok',
$ '',
$ '', f4.1, '',
$ '')
6256 format('',
$ f5.1, '',
$ f5.1, '')
6257 format('',
$ f5.1, '',
$ f5.1, '', i4,
$ '',
$ '', f5.1,
$ '',
$ '',
$ '', f5.1,
$ '',
$ '')
c write the `header' of the strategy information
xmlline = ' '
write(xmlline, fmt = 6255) pcmax
call write_socket_section(serverfd, lenstr(xmlline),
$ xmlline)
end if
DO 30 IPHI = IPHSTART,IIEND,IPHSTEP
IPART = IPART + 1
IF (IPHI.EQ.IPHEND-IPHSTEP) GOTO 28
IF (OSCBEST(IPART+1).EQ.OSCBEST(IPART)) GOTO 30
28 NSTEP = NINT((REAL(IPHI+IPHSTEP)-PHI1)/OSCBEST(IPART))
PHI2 = PHI1 + NSTEP*OSCBEST(IPART)
C
C---- Ensure final phi value is .ge. phiend
C
IF ((IPHI.EQ.IPHEND-IPHSTEP).AND.(PHI2.LT.REAL(IPHEND))) THEN
NSTEP = NSTEP + 1
PHI2 = PHI1 + NSTEP*OSCBEST(IPART)
END IF
IF (NSTEP.NE.0) THEN
WRITE(IOUT,FMT=6062) PHI1,PHI2,NSTEP,OSCBEST(IPART),
+ FRACBEST(IPART),FULLBEST(IPART)
IF (ONLINE) WRITE(ITOUT,FMT=6062) PHI1,PHI2,NSTEP,
+ OSCBEST(IPART),FRACBEST(IPART),FULLBEST(IPART)
IF(SOCKLO) THEN
c new style
xmlline = ' '
write(xmlline, fmt = 6257) phi1, (phi2 - phi1) /
$ real(nstep), nstep,
$ fullbest(ipart), fracbest(ipart)
call write_socket_section(serverfd, lenstr(xmlline),
$ xmlline)
c write(xmlfrag, fmt=8062) phi1, phi2 - phi1, nstep,
c $ fullbest(ipart), fracbest(ipart)
c xmllength = lenstr(xmlfrag)
c call write_socket_section(serverfd, xmlfrag, xmllength)
end if
IF (WINOPEN) THEN
WRITE(LINE,FMT=6114) PHI1,PHI2,NSTEP,OSCBEST(IPART),
+ FRACBEST(IPART),FULLBEST(IPART)
6114 FORMAT(F6.1,F10.1,I14,F15.2,F16.1,F14.1)
CALL MXDWIO(LINE,2)
END IF
END IF
PHI1 = PHI2
30 CONTINUE
if(socklo) then
xmlline = ' '
xmlline = ''
xmllength = lenstr(xmlline)
call write_socket_length(serverfd, xmllength, xmlline)
end if
6062 FORMAT(1X,F6.1,F10.1,I14,F15.2,F16.1,F14.1)
c 8062 FORMAT('', F6.1, '',
c $ F6.1, '', I4, '',
c $ '', F8.1, '',
c $ '', F8.1, '',
c $ '')
C
40 IF (FIXANG) THEN
WRITE(IOUT,FMT=6064) 2.0*ETA/DTR,0.01*IXSEP,0.01*IYSEP
IF (ONLINE) WRITE(ITOUT,FMT=6064) 2.0*ETA/DTR,0.01*IXSEP,
+ 0.01*IYSEP
ELSE
WRITE(IOUT,FMT=6066) 2.0*ETA/DTR,0.01*IXSEP,0.01*IYSEP
IF (ONLINE) WRITE(ITOUT,FMT=6066) 2.0*ETA/DTR,0.01*IXSEP,
+ 0.01*IYSEP
END IF
6064 FORMAT(/,1X,'***** IMPORTANT *****',/,1X,'The overlap',
+ ' depends critically on the estimates of mosaic spread',/,
+ 1X,'and the SEPARATION parameters. These values MUST be ',
+ 'realistic, or you may',/,1X,'not end up with a complete',
+ ' dataset.',/,1X,'In particular, the spot separation ',
+ 'parameters should be at least as large',/,1X,'as the ',
+ 'spot size in the centre of the image.',/,1X,
+ 'Current values: Mosaic spread ',F4.2,' Spot separation',
+ 2F6.2,'mm')
6066 FORMAT(/,1X,'***** IMPORTANT *****',/,1X,'The suggested values',
+ ' depend critically on the estimates of mosaic spread',/,
+ 1X,'and the SEPARATION parameters. These values MUST be ',
+ 'realistic, or you may',/,1X,'not end up with a complete',
+ ' dataset.',/,1X,'In particular, the spot separation ',
+ 'parameters should be at least as large',/,1X,'as the ',
+ 'spot size in the centre of the image.',/,1X,
+ 'Current values: Mosaic spread ',F4.2,' Spot separation',
+ 2F6.2,'mm',
+ //,1X,'These are the MAXIMUM possible ',
+ 'oscillation angles.',/,1X,
+ 'A better signal to noise may be achieved by using a',
+ ' smaller oscillation',/,1X,'angle if the oscillation',
+ ' angles suggested are greater than the rocking width',
+ /,1X,'(mosaic spread plus beam divergence)'/)
IF (WINOPEN) THEN
LINE = '***** IMPORTANT *****'
CALL MXDWIO(LINE,2)
IF (FIXANG) THEN
WRITE(LINE,FMT=6120)
6120 FORMAT('The overlap',
+ ' depends critically on the estimates of mosaic spread')
ELSE
WRITE(LINE,FMT=6121)
6121 FORMAT('The suggested values',
+ ' depend critically on the estimates of mosaic spread')
END IF
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6122)
6122 FORMAT('and the SEPARATION parameters. These values MUST be ',
+ 'realistic, or you may')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6124)
6124 FORMAT('not end up with a complete dataset.')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6126)
6126 FORMAT('In particular, the spot separation ',
+ 'parameters should be at least as large')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6128)
6128 FORMAT('as the ',
+ 'spot size in the centre of the image.')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6130) 2.0*ETA/DTR,0.01*IXSEP,0.01*IYSEP
6130 FORMAT('Current values: Mosaic spread ',F4.2,
+ ' Spot separation',2F6.2,'mm')
CALL MXDWIO(LINE,2)
IF (.NOT.FIXANG) THEN
WRITE(LINE,FMT=6132)
6132 FORMAT('These are the MAXIMUM possible ',
+ 'oscillation angles.')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6134)
6134 FORMAT('A better signal to noise may be achieved by using a',
+ ' smaller oscillation')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6136)
6136 FORMAT('angle if the oscillation',
+ ' angles suggested are greater than the rocking width')
CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6138)
6138 FORMAT('(mosaic spread plus beam divergence).')
END IF
END IF
C
C---- Print statistics
C
C ****************
C CALL PRINTTEST(ANGLE)
C ****************
C
C---- Reset stats
C
DO 90 J = 1,MAXPAX
DO 80 K = 1,3
ISTATS(J,K) = 0
80 CONTINUE
90 CONTINUE
C
C---- Set NSPOT to zero so last generated list is not displayed
C
NSPOT = 0
RETURN
END
C***************************************************************************
C***
SUBROUTINE TIFF(FILIN,MAP,NCOLS,NROWS,IERR)
C***
C DEBUG(66) for this subroutine
C***************************************************************************
C IMPLICIT NONE
INTEGER*4 ISTARTBLOCK
PARAMETER (ISTARTBLOCK = 1)
INTEGER*4 LRECL
PARAMETER (LRECL = 0)
INTEGER*4 MAXCOLS
PARAMETER (MAXCOLS = 14000)
INTEGER*4 MODE_TIFF
PARAMETER (MODE_TIFF = 0)
INTEGER*4 NTAG_VALUES
PARAMETER (NTAG_VALUES = 32)
C***
BYTE IBUF(MAXCOLS*2)
BYTE VALUE_TYPE1
C***
CHARACTER FILIN*(*)
CHARACTER TEXT*80
CHARACTER VALUE_TYPE2
CHARACTER YESNO*1
C***
INTEGER*2 BUF(MAXCOLS)
INTEGER*2 FIELD_TYPE
INTEGER*2 INT2
INTEGER*2 MAP(*)
INTEGER*2 TAG
INTEGER*2 VALUE_TYPE3
C***
INTEGER*4 DENOMINATOR
INTEGER*4 FILETAG
INTEGER*4 IOFFSET
INTEGER*4 IMAGEDESCRIPTION
INTEGER*4 INT4
INTEGER*4 LENGTH
INTEGER*4 NUMERATOR
INTEGER*4 RESOLUTIONUNIT
INTEGER*4 SAMPLEFORMAT
INTEGER*4 STRIPBYTECOUNTS
INTEGER*4 STRIPOFFSETS
INTEGER*4 TAG_VALUES(NTAG_VALUES)
INTEGER*4 VALUE_OFFSET
INTEGER*4 VALUE_TYPE4
INTEGER*4 XRESOLUTION
INTEGER*4 YRESOLUTION
INTEGER*4 IFIELD_TYPE
C***
LOGICAL CHESS
LOGICAL MOTOROLA
LOGICAL NEWTAG
C***
INTEGER LENSTR
EXTERNAL LENSTR,QREAD
INTEGER*4 NCHAR
C
EQUIVALENCE (BUF,IBUF)
EQUIVALENCE (IOFFSET,IBUF(1))
EQUIVALENCE (TAG,IBUF(1))
EQUIVALENCE (FIELD_TYPE,IBUF(3))
EQUIVALENCE (LENGTH,IBUF(5))
EQUIVALENCE (VALUE_TYPE1,IBUF(9))
EQUIVALENCE (VALUE_TYPE2,IBUF(9))
EQUIVALENCE (VALUE_TYPE3,IBUF(9))
EQUIVALENCE (VALUE_TYPE4,IBUF(9))
EQUIVALENCE (NUMERATOR,IBUF(1))
EQUIVALENCE (DENOMINATOR,IBUF(5))
EQUIVALENCE (INT2,IBUF(1))
EQUIVALENCE (INT4,IBUF(1))
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C***
C ..
C .. External Functions ..
LOGICAL LITEND
C
DATA TAG_VALUES/254,255,256,257,258,259,
* 262,266,269,
* 270,271,272,273,274,277,278,279,
* 280,281,282,283,284,285,286,287,
* 296,
* 305,306,315,316,
* 339,
* 32997/
C***
C**************** start of program *********************************
C*** initialize
CHESS = .FALSE.
NEWTAG = .FALSE.
NSAMPLES_PER_PIXEL = 1
IERR = 0
C*** open input tiff file and set the mode. Changed from Martin 10/12/96
NCHAR=LENSTR(FILIN)
CALL QOPEN(INOD,FILIN(1:NCHAR),'READONLY')
CALL QMODE(INOD,MODE_TIFF,NCHITM)
C*** read tiff header
C*** read first 2 bytes
IELEMENT = 1
NITEMS = 4
CALL QSEEK(INOD,ISTARTBLOCK,IELEMENT,LRECL)
CALL QREAD(INOD,IBUF,NITEMS,IER)
IF(IER.NE.0) GO TO 8500
C*** test first two bytes contain intel format
WRITE(TEXT(1:1),'(A)') IBUF(1)
WRITE(TEXT(2:2),'(A)') IBUF(2)
IF(TEXT(1:2) .EQ. 'II') THEN
MOTOROLA = .FALSE.
ELSE IF(TEXT(1:2) .EQ. 'MM') THEN
MOTOROLA = .TRUE.
ELSE
WRITE(6,FMT=100)
100 FORMAT(1X,'Neither Motorola nor Intel format- cannot proceed')
GO TO 8500
END IF
IF (.NOT.LITEND()) MOTOROLA = .NOT.MOTOROLA
IF (MOTOROLA) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
6000 FORMAT(1X,'Image will be byte swapped')
ELSE
WRITE(IOUT,FMT=6002)
IF (ONLINE) WRITE(ITOUT,FMT=6002)
6002 FORMAT(1X,'Image will not be byte swapped')
END IF
C*** ignore next two bytes, (version number)
IF(IER.NE.0) GO TO 8500
C*** position pointer to next byte
IELEMENT = IELEMENT + NITEMS
C*****************************************************
C*** extract offset for Image File Directory
C*****************************************************
1000 CALL QSEEK(INOD,ISTARTBLOCK,IELEMENT,LRECL)
NITEMS = 4
CALL QREAD(INOD,IBUF,NITEMS,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA) CALL BYTE_SWAP_FOUR_BYTES(IBUF(1),NITEMS)
IF(IOFFSET .EQ. 0) GO TO 3000
C*** read number of entries for this directory
IELEMENT = IOFFSET + 1
CALL QSEEK(INOD,ISTARTBLOCK,IELEMENT,LRECL)
NITEMS = 2
CALL QREAD(INOD,IBUF,NITEMS,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA) CALL BYTE_SWAP_TWO_BYTES(IBUF(1),NITEMS)
NENTRIES = INT2
IF (DEBUG(66)) THEN
WRITE(IOUT,FMT=6010) IELEMENT,NENTRIES
IF (ONLINE) WRITE(ITOUT,FMT=6010) IELEMENT,NENTRIES
6010 FORMAT(1X,'In subroutine TIFF',/,1X,'IELEMENT=',I10,
+ ' NENTRIES=',I10)
END IF
C*** loop to extract tag information
IELEMENT = IELEMENT + NITEMS
NITEMS = 12
DO N=1,NENTRIES
CALL QSEEK(INOD,ISTARTBLOCK,IELEMENT,LRECL)
CALL QREAD(INOD,IBUF,NITEMS,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA) THEN
CALL BYTE_SWAP_TWO_BYTES(IBUF(1),4)
CALL BYTE_SWAP_FOUR_BYTES(IBUF(5),4)
IF(FIELD_TYPE .EQ. 3) THEN
CALL BYTE_SWAP_TWO_BYTES(IBUF(9),2)
VALUE_OFFSET = VALUE_TYPE3
ELSE IF(FIELD_TYPE .EQ. 4) THEN
CALL BYTE_SWAP_FOUR_BYTES(IBUF(9),4)
VALUE_OFFSET = VALUE_TYPE3
END IF
END IF
ITAG = TAG
IFIELD_TYPE = FIELD_TYPE
IF (DEBUG(66)) THEN
WRITE(IOUT,FMT=6012) N, ITAG, VALUE_OFFSET
IF (ONLINE) WRITE(ITOUT,FMT=6012) N, ITAG, VALUE_OFFSET
6012 FORMAT(1X,'Entry number',I10,' itag=',i10,' value_offset',
+ I10)
END IF
IF(ITAG .LT. 0) ITAG = 65536 + ITAG
C***
C*** check tag in list
C*** subfiletype
IF(ITAG .EQ. 254) THEN
IF(VALUE_TYPE4 .NE. 0) GO TO 8000
C*** SubfileType
ELSE IF(ITAG .EQ. 255) THEN
IF(VALUE_TYPE3 .NE. 1) THEN
WRITE(6,'('' IMAGE NOT FULL RESOLUTION'')')
GO TO 8000
END IF
C*** ImageWidth
ELSE IF(ITAG .EQ. 256) THEN
IF(IFIELD_TYPE .EQ. 3) THEN
NCOLS = VALUE_TYPE3
ELSE
NCOLS = VALUE_TYPE4
END IF
IF (DEBUG(66)) write(6,'('' ImageWidth = '',i)')ncols
C*** ImageLength
ELSE IF(ITAG .EQ. 257) THEN
IF(IFIELD_TYPE .EQ. 3) THEN
NROWS = VALUE_TYPE3
ELSE
NROWS = VALUE_TYPE4
END IF
IF (DEBUG(66)) WRITE(6,'('' IMAGELENGTH = '',I)')NROWS
C*** BITSPERSAMPLE
ELSE IF(ITAG .EQ. 258) THEN
IF(VALUE_TYPE3 .EQ. 8) THEN
MODE_IMAGE = 0
ELSE IF(VALUE_TYPE3 .EQ. 16) THEN
MODE_IMAGE = 1
ELSE
GO TO 8000
END IF
NBITS_PER_SAMPLE = VALUE_TYPE3
IF (DEBUG(66)) WRITE(6,'('' BITSPERSAMPLE = '',I)')
+ NBITS_PER_SAMPLE
C*** COMPRESSION
ELSE IF(ITAG .EQ. 259) THEN
IF(VALUE_TYPE3 .NE. 1) GO TO 8000
C*** PHOTOMETRIC
ELSE IF(ITAG .EQ. 262) THEN
IF(VALUE_TYPE3 .LT. 0 .OR. VALUE_TYPE3 .GT. 2)
* GO TO 8000
C*** FILLORDER
ELSE IF(ITAG .EQ. 266) THEN
IF(VALUE_TYPE3 .NE. 1) GO TO 8000
C*** DOCUMENTNAME
ELSE IF(ITAG .EQ. 269) THEN
GO TO 2000
C*** IMAGEDESCRIPTION
ELSE IF(ITAG .EQ. 270) THEN
GO TO 2000
C*** MAKE
ELSE IF(ITAG .EQ. 271) THEN
GO TO 2000
C*** MODEL
ELSE IF(ITAG .EQ. 272) THEN
GO TO 2000
C*** STRIPOFFSETS
ELSE IF(ITAG .EQ. 273) THEN
IF(IFIELD_TYPE .EQ. 3) THEN
STRIPOFFSETS = VALUE_TYPE3
ELSE
STRIPOFFSETS = VALUE_TYPE4
END IF
C*** IF LENGTH > 1 READ OFFSET TO GET VALUE FOR START OF IMAGE
IF(LENGTH .GT. 1) THEN
CALL QSEEK(INOD,ISTARTBLOCK,STRIPOFFSETS+1,LRECL)
IF(IFIELD_TYPE .EQ. 3) THEN
CALL QREAD(INOD,IBUF,2,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA)
* CALL BYTE_SWAP_TWO_BYTES(IBUF(1),2)
STRIPOFFSETS = INT2
ELSE
CALL QREAD(INOD,IBUF,4,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA)
* CALL BYTE_SWAP_FOUR_BYTES(IBUF(1),4)
STRIPOFFSETS = INT4
END IF
END IF
C*** SHOULD REALLY READ ALL THE VALUES AND CHECK THEIR DIFFERENCES ARE IDENTICAL
IF (DEBUG(66)) WRITE(6,'('' STRIPOFFSETS ='',I)')
+ STRIPOFFSETS
C*** ORIENTATION
ELSE IF(ITAG .EQ. 274) THEN
IF(VALUE_TYPE3 .NE. 1) GO TO 8000
C*** SAMPLESPERPIXEL
ELSE IF(ITAG .EQ. 277) THEN
IF(VALUE_TYPE3 .LT. 1 .OR. VALUE_TYPE3 .GT.2)
* GO TO 8000
NSAMPLES_PER_PIXEL = VALUE_TYPE3
IF (DEBUG(66)) WRITE(6,'('' SAMPLESPERPIXEL ='',I)')
* NSAMPLES_PER_PIXEL
C*** ROWSPERSTRIP
ELSE IF(ITAG .EQ. 278) THEN
IF(IFIELD_TYPE .EQ. 3) THEN
NROWSPERSTRIP = VALUE_TYPE3
ELSE
NROWSPERSTRIP = VALUE_TYPE4
END IF
IF (DEBUG(66)) WRITE(6,'('' ROWSPERSTRIP ='',I)')
+ NROWSPERSTRIP
NSTRIPSPERIMAGE = (NROWS + NROWSPERSTRIP - 1) / NROWSPERSTRIP
C*** STRIPBYTECOUNTS
ELSE IF(ITAG .EQ. 279) THEN
CALL QSEEK(INOD,ISTARTBLOCK,VALUE_OFFSET+1,LRECL)
IF(IFIELD_TYPE .EQ. 3) THEN
CALL QREAD(INOD,IBUF,2,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA)
* CALL BYTE_SWAP_TWO_BYTES(IBUF(1),2)
STRIPBYTECOUNTS = INT2
ELSE
CALL QREAD(INOD,IBUF,4,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA)
* CALL BYTE_SWAP_FOUR_BYTES(IBUF(1),4)
STRIPBYTECOUNTS = INT4
END IF
C*** CHECK STRIPBYTECOUNTS IDENTICAL. IF NOT, PROGRAM NEEDS REWRITE
C*** TO ACCOMMODATE POINTER READING FOR EACH STRIP
IF(NSTRIPSPERIMAGE .GT. 1) THEN
DO I=1,NSTRIPSPERIMAGE
ITEMP = STRIPBYTECOUNTS
CALL QSEEK(INOD,ISTARTBLOCK,VALUE_OFFSET+1,LRECL)
IF(IFIELD_TYPE .EQ. 3) THEN
CALL QREAD(INOD,IBUF,2,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA)
* CALL BYTE_SWAP_TWO_BYTES(IBUF(1),2)
STRIPBYTECOUNTS = INT2
ELSE
CALL QREAD(INOD,IBUF,4,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA)
* CALL BYTE_SWAP_FOUR_BYTES(IBUF(1),4)
STRIPBYTECOUNTS = INT4
END IF
IF(ITEMP .NE. STRIPBYTECOUNTS) THEN
WRITE(6,FMT=110)
110 FORMAT(1X,'WARNING - UNEVEN STRIPBYTECOUNTS. ',
* 'OUTPUT FILE MAY BE INCORRECT')
GO TO 2000
END IF
END DO
END IF
IF (DEBUG(66)) WRITE(6,'('' STRIPBYTECOUNTS ='',I)')
+ STRIPBYTECOUNTS
C*** MINSAMPLEVALUE
ELSE IF(ITAG .EQ. 280) THEN
MIN_VALUE = VALUE_TYPE3
IF(MIN_VALUE .LT. 0) MIN_VALUE = MIN_VALUE + 65536
IF (DEBUG(66)) WRITE(6,'('' MINSAMPLEVALUE = '',I)')
+ MIN_VALUE
GO TO 2000
C*** MAXSAMPLEVALUE
ELSE IF(ITAG .EQ. 281) THEN
MAX_VALUE = VALUE_TYPE3
IF(MAX_VALUE .LT. 0) MAX_VALUE = MAX_VALUE + 65536
IF (DEBUG(66)) WRITE(6,'('' MAXSAMPLEVALUE = '',I)')
+ MAX_VALUE
GO TO 2000
C*** XRESOLUTION
ELSE IF(ITAG .EQ. 282) THEN
CALL QSEEK(INOD,ISTARTBLOCK,VALUE_OFFSET+1,LRECL)
CALL QREAD(INOD,IBUF,8,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA) CALL BYTE_SWAP_FOUR_BYTES(IBUF(1),8)
XRESOLUTION = NINT(FLOAT(NUMERATOR) / FLOAT(DENOMINATOR))
GO TO 2000
C*** YRESOLUTION
ELSE IF(ITAG .EQ. 283) THEN
CALL QSEEK(INOD,ISTARTBLOCK,VALUE_OFFSET+1,LRECL)
CALL QREAD(INOD,IBUF,8,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA) CALL BYTE_SWAP_FOUR_BYTES(IBUF(1),8)
YRESOLUTION = NINT(FLOAT(NUMERATOR) / FLOAT(DENOMINATOR))
GO TO 2000
C*** PLANARCONFIGURATION
ELSE IF(ITAG .EQ. 284) THEN
IF(VALUE_TYPE3 .NE. 1) GO TO 8000
C*** PAGENAME
ELSE IF(ITAG .EQ. 285) THEN
GO TO 2000
C*** XPOSITION
ELSE IF(ITAG .EQ. 286) THEN
GO TO 2000
C*** YPOSITION
ELSE IF(ITAG .EQ. 287) THEN
GO TO 2000
C*** RESOLUTIONUNIT
ELSE IF(ITAG .EQ. 296) THEN
RESOLUTIONUNIT = VALUE_TYPE3
GO TO 2000
C*** SOFTWARE
ELSE IF(ITAG .EQ. 305) THEN
GO TO 2000
C*** DATETIME
ELSE IF(ITAG .EQ. 306) THEN
GO TO 2000
C*** ARTIST
ELSE IF(ITAG .EQ. 315) THEN
GO TO 2000
C*** HOSTCOMPUTER
ELSE IF(ITAG .EQ. 316) THEN
GO TO 2000
C*** SAMPLEFORMAT
ELSE IF(ITAG .EQ. 339) THEN
SAMPLEFORMAT = VALUE_TYPE3
IF (DEBUG(66)) WRITE(6,'('' SAMPLEFORMAT ='',I)')
+ SAMPLEFORMAT
IF(SAMPLEFORMAT .NE. 1) GO TO 8000
C*** IMAGEDEPTH
ELSE IF(ITAG .EQ. 32997) THEN
IF(IFIELD_TYPE .EQ. 3) THEN
NSECS = VALUE_TYPE3
ELSE
NSECS = VALUE_TYPE4
END IF
IF(NSECS .NE. 1) THEN
WRITE(6,'('' MULTIPLE SECTION FILE..CANNOT CONTINUE'')')
GO TO 8200
END IF
IF (DEBUG(66)) WRITE(6,'('' IMAGEDEPTH = '',I)') NSECS
C*** PRIVATE CHESS TAG(S)
ELSE IF(ITAG .GE. 36864 .AND. ITAG .LE. 37120) THEN
CHESS = .TRUE.
GO TO 2000
C*** UNKNOWN TAG
ELSE
NEWTAG = .TRUE.
WRITE(6,FMT=130) ITAG, IFIELD_TYPE, LENGTH, VALUE_OFFSET
130 FORMAT(1X,'UNKNOWN TAG = ',I5,
* ' TYPE = ',I5,' LENGTH = ',I5,' OFFSET =',I8)
END IF
2000 IELEMENT = IELEMENT + NITEMS
END DO
GO TO 1000
C*****************************************************
C*** CHECK MAP CAN BE READ CORRECTLY
C*****************************************************
3000 IF(.NOT. CHESS) THEN
WRITE(6,'('' UNKNOWN DATA TYPE'')')
GO TO 8200
C*** MAXCOLS TOO SMALL
ELSE IF(NCOLS .GT.MAXCOLS) THEN
WRITE(6,'('' PARAMETER MAXCOLS TOO SMALL'')')
GO TO 8200
C*** UNKNOWN TAG ?
ELSE IF(NEWTAG) THEN
WRITE(6,'('' UNKNOWN TAG(S) PRESENT'')')
GO TO 8200
END IF
NBYTES_PER_ROW = (NCOLS * NSAMPLES_PER_PIXEL *
* NBITS_PER_SAMPLE + 7) / 8
IELEMENT = STRIPOFFSETS + 1
C*** LOOP THROUGH DATA TO WRITE IMAGE FORMAT MAP
DO N = 1,NROWS
CALL QSEEK(INOD,ISTARTBLOCK,IELEMENT,LRECL)
CALL QREAD(INOD,IBUF,NBYTES_PER_ROW,IER)
IF(IER.NE.0) GO TO 8500
IF(MOTOROLA .AND. MODE_IMAGE .EQ. 1)
* CALL BYTE_SWAP_TWO_BYTES(IBUF(1),NBYTES_PER_ROW)
NSKIP = NCOLS * (N - 1)
IELEMENT = IELEMENT + NBYTES_PER_ROW
DO I = 1,NCOLS
C
C---- CONVERT TO STORE AS IOD/8 IF GT 32767
C
IF (BUF(I).LT.0) BUF(I) = -(BUF(I)+65536+4)/8
MAP(NSKIP+I) = FLOAT(BUF(I))
END DO
END DO
RETURN
C***********************************************************
C*** DIAGNOSTICS
C***********************************************************
C*** TAG ERROR
8000 WRITE(6,FMT=140) ITAG, IFIELD_TYPE, LENGTH, VALUE_OFFSET
140 FORMAT(1X,'TAG ',I6,' VALUE UNKNOWN/INCORRECT',/,1X,
* 'TAG VALUES :',4I10)
IERR = 1
RETURN
C*** VALUE CHECK ERROR
8200 CONTINUE
IERR = 2
RETURN
C*** ERROR
8500 WRITE(6,'('' ERROR READING INPUT FILE'')')
IERR = 3
RETURN
END
C***********************************************************************
C***
SUBROUTINE BYTE_SWAP_TWO_BYTES(BUFFER,NBYTES)
C***
C**********************************************************************
BYTE BUFFER(NBYTES)
BYTE BTEMP
C***
DO I=1,NBYTES,2
BTEMP = BUFFER(I)
BUFFER(I) = BUFFER(I+1)
BUFFER(I+1) = BTEMP
END DO
RETURN
END
C***********************************************************************
C***
SUBROUTINE BYTE_SWAP_FOUR_BYTES(BUFFER,NBYTES)
C***
C**********************************************************************
BYTE BUFFER(NBYTES)
BYTE BTEMP
C***
DO I=1,NBYTES,4
BTEMP = BUFFER(I)
BUFFER(I) = BUFFER(I+3)
BUFFER(I+3) = BTEMP
BTEMP = BUFFER(I+1)
BUFFER(I+1) = BUFFER(I+2)
BUFFER(I+2) = BTEMP
END DO
RETURN
END
C
C---- $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE TO_DPS_INDEX(NSOL,INVERTX,OMEGAF,RFIXCELL,RFIXDIST,
$ MAXCELL)
C ===============================================================
C
C
C last label 390, first format 6500, last format 6990
C
IMPLICIT NONE
C
C--- This interfaces MOSFLM to DPS_INDEX. This is called from MXDSPL
C
C Cribbed from TOREFIX.F
C
C Information needed here from MOSFLM;
C (1) Unknown cell
C Distance
C Wavelength
C Spot list
C Delphi
C (2) Post-indexing (known cell)
C Crystal system
C A (UB) matrix - AMAT
C
C Information used by REFIX that we don't seem to use here, but perhaps we
C should!
C Spacegroup
C Distortion parameter CCOMEGA
C
C Information to be passed back to MOSFLM;
C (1) List of solutions
C unrefined cell encoded in orientation matrix AMAT
C Error flag if autoindexing did not work
C (2) Refined cell and orientation
C
C NSOL = interactive processing via GUI,
C returned between 1 & 44 if cell dimensions and space group given
C " " -1 & -44 if no cell given
C NSOL = -999 background autoindexing, known or unknown cell.
C NSOL in range 1 - 44 cell chosen from interactive processing via GUI,
C refines solution.
C in range 101 - 144 solution chosen from list, forces program to
C accept an otherwise distasteful solution.
C NSOL in range -44 - -1 cell chosen by program (from NSOL = -999 above)
C and refines cell.
C
C aP [1,P1]
C mP [3,P2] [4,P2(1)]
C mC,mI [5,C2]
C oP [16,P222] [17,P222(1)] [18,P2(1)2(1)2] [19,P2(1)2(1)2(1)]
C oC [21,C222] [20,C222(1)]
C oF [22,F222]
C oI [23,I222] [24,I2(1)2(1)2(1)]
C tP [75,P4] [76,P4(1)] [77,P4(2)] [78,P4(3)] [89,P422] [90,P42(1)2]
C [91,P4(1)22] [92,P4(1)2(1)2] [93,P4(2)22] [94,P4(2)2(1)2]
C [95,P4(3)22] [96,P4(3)2(1)2]
C tI [79,I4] [80,I4(1)] [97,I422] [98,I4(1)22]
C hP [143,P3] [144,P3(1)] [145,P3(2)] [149,P312] [150,P321] [151,P3(1)12]
C [152,P3(1)21] [153,P3(2)12] [154,P3(2)21] [168,P6] [169,P6(1)]
C [170,P6(5)] [171,P6(2)] [172,P6(4)] [173,P6(3)] [177,P622]
C [178,P6(1)22] [179,P6(5)22] [180,P6(2)22] [181,P6(4)22] [182,P6(3)22]
C hR [146,R3] [155,R32]
C cP [195,P23] [198,P2(1)3] [207,P432] [208,P4(2)32] [212,P4(3)32]
C [213,P4(1)32]
C cF [196,F23] [209,F432] [210,F4(1)32]
C cI [197,I23] [199,I2(1)3] [211,I432] [214,I4(1)32]
C
INTEGER NPARM
PARAMETER (NPARM = 200)
C
C .. Scalar Arguments ..
INTEGER NSOL
LOGICAL SPOTSREAD,BOXOPEN
C
C ..
C .. Local Scalars ..
INTEGER I,ICHECK,NLAUEG,J,K,KI,INDEX,IXW,IYW,
+ LINELEN,NUMLIN,GOOD,L2,MISMATCH,LASTGOOD,HIGHSYMM,
+ BESTSOL,SNUMSPG
REAL NORMALIZE,TESTGOOD,MAXGOOD,test1,test2,test3
CHARACTER LATTYP*1,STR1*1,LINE*90,SPLISTB*57,BTSTR*2,STR*200,
+ LLINE*150,LINE2*80,CMATNAME(40)*1, ioline2*4096
LOGICAL USERDMAX,USERCELL,STARTLIST,NOCHOICE,BADUSERCELL
C ..
C .. Local Arrays ..
REAL TMAT(3,3),TARCELL(6)
C ..
C
C---- Things for parser
C
INTEGER IBEG(NPARM),IDEC(NPARM),IEND(NPARM),ITYP(NPARM)
REAL VALUE(NPARM)
INTEGER NTOK
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C .. External Subroutines ..
EXTERNAL CELLFIX,SETMAT,MXDCIO,
+ MXDWIO,MXDRIO,MATMUL3,PERMUTATE,SORTUP2
LOGICAL INVERTX
C ..
C .. Intrinsic Functions ..
C ..
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C .. Common blocks ..
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/dpsindex.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C---- START of include file dpsindex.h
C
C
REAL DISTANCE,XTD,WAVELENGTH,XBEAM,YBEAM,PHIAV,DMAX,
$ ORGX,ORGY,XCOR,YCOR
INTEGER*4 IXD,IYD,IPHI,SOLN
INTEGER*2 IH,IK,IL
LOGICAL INDNOREF,DPSINDEX,PREREF,LSOL
COMMON /DPSINDEX/ DISTANCE,XTD,WAVELENGTH,XBEAM,YBEAM,
$ PHIAV,DMAX,ORGX,ORGY,XCOR,YCOR,IXD(5000),
$ IYD(5000),IPHI(5000),SOLN,IH(5000),IK(5000),
$ IL(5000),INDNOREF,DPSINDEX,PREREF,LSOL
C
C
C COMMON BLOCK USED IN PERMUTING THE CELL
C
REAL KCELL(6)
INTEGER KICRYST
COMMON /PERMUTE/ KCELL,KICRYST
C
C
C&&*&& end_include ../inc/dpsindex.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C&&*&& include ../inc/mharvest.f
INTEGER MAXMTZ
PARAMETER (MAXMTZ = 16)
C .. Scalars in common block /CHARVEST/ ..
CHARACTER HVERSION*80,ProjectName*20,DataSetName*20,
+ HBEAMLINE*10,Precipitant*80,
+ PNAME_COLS(MAXMTZ)*20,
+ DNAME_COLS(MAXMTZ)*20
C .. Scalars in common block /IHARVEST/ ..
LOGICAL USECWD,PNAMEgiven,DNAMEgiven,DOHARVEST
REAL PHhar,Hartemp,
+ HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
CHARACTER*3 MKDIRMODE,CHMODMODE
INTEGER KHFLMS
C ..
C .. Common block /CHARVEST/ ..
COMMON /CHARVEST/HVERSION,ProjectName,DataSetName,
+ HBEAMLINE,Precipitant,
+ PNAME_COLS,DNAME_COLS
C .. Common block /IHARVEST/ ..
COMMON /IHARVEST/USECWD,PHhar,Hartemp,KHFLMS,
+ PNAMEgiven,DNAMEgiven,DOHARVEST,
+ HARETA,HARDIV,HARDIH,MKDIRMODE,CHMODMODE
C ..
C&&*&& end_include ../inc/mharvest.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/sys.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file sys.h
C---- START of include file sys.h
C
C
C .. Scalars in Common Block /SYS/ ..
INTEGER ISYS
C ..
C .. Arrays in Common Block /SYS/ ..
INTEGER KSYS
C ..
C .. Common Block /SYS/ ..
COMMON /SYS/ISYS,KSYS(3)
C ..
C
C
C&&*&& end_include ../inc/sys.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C
C
C local scalars for compatibility with REFIX
C
REAL COSOM,SINOM,CPSI,SPSI,PSI,RADBS,XN,YN,XP,YP,XFN,YFN,YMID,
$ MINSEP
c gw
integer ipx, ipy
integer*2 spot_position(NSPOTS)
C
C
C Arguments to be passed to refinement routine ripped off from REFIX
C
LOGICAL RFIXCELL,RFIXDIST
INTEGER IGROUP,FIXF,NCYCLE,IC,ICS,ICSN,ITERATE,NACC
INTEGER*2 REIDX0(12)
INTEGER*4 NREF,IERR
REAL FLAMBDA,F,Q,DPHI,CCX,CCY,CCOM,DXY,SDU,SDCELL(6),VOLUME
LOGICAL TARGET,DCOMP,LCAMC,FILM,FIXCELL
REAL RFCELL(6),ED(3,3),ACHSE(3),S0L(3),TARMAT(3,3),ASTV(3),
$ BSTV(3),CSTV(3),SCELL(6)
REAL*4 S(3),SD(3),V(3,5000)
C COMMON /REFCOM/IGROUP,FLAMBDA,RFCELL,F,THRESH,Q,DPHI,ED,
C + ACHSE,S0L,ORGX,ORGY,FIXF,TARMAT,TARGET,DCOMP,
C + LCAMC,CCX,CCY,CCOM,FILM,DXY,FIXCELL
C INTEGER NCYCLE,REIDX(12),IPHI(5000),IC,ICS,Q,ORGX,ORGY,
C REAL ACHSE(3),
REAL RFROFF,RFTOFF,MINSPLIT,invcell,mincell,maxcell
integer bincell(100)
COMMON /DISTOR/ RFROFF,RFTOFF
COMMON /FNAMES/ SPOTFL,MATNAME
CHARACTER SPOTFL*100,MATNAME*80
INTEGER*2 ITEMP(1)
INTEGER II,III,ICO,JCO
REAL MEANERR,sumsqdiff,REFLERR(5000)
REAL SDCUTOFF
INTEGER NBAD(3)
C
C---- Common blocks for passing results from REFIX back to MOSFLM
C RFAMAT contains A-matrix
C RESLIST/RESLISTC contain list of 44 Laue groups
C
COMMON /RESLIST/ LATCH,P,CELLB,SDXY,SDPHI,IERR
INTEGER*2 LATCH(44)
REAL P(44),CELLB(6,44),CELLS(3),CELLCH(3)
REAL SDXY,SDPHI
INTEGER NSPOT
COMMON /RESLISTC/ BT
CHARACTER*2 BT(44)
CHARACTER LTYPE(15)*2,SPLIST(15)*70
C
C---- Common block for I/O
C
LOGICAL RFONLINE
INTEGER RFLP,RFLINOUT
COMMON /RINOUT/ RFONLINE,RFLP,RFLINOUT
C
C ..
INTEGER*2 MERIT(44),IRESORDER(44),MERITMIN,INORMALIZE
INTEGER*2 LCLASS(6,8)
REAL MERITMAX
INTEGER IDATA,OM_OUT,COUNT,RCOUNT
INTEGER ITEST(15)
INTEGER IFAIL,MATNUM,LDUM
INTEGER IBUTTON,L,IXP,IYP,XDLSTR
REAL FINVERTX
C
C DPS and local variables
C
REAL XTEMP,YTEMP,THRESHOLD,SIGTHRESH,RASTY
REAL X(5000),Y(5000),Z(5000),RESMAX,RESMIN
REAL X_SPOT(5000),Y_SPOT(5000),PHIMEAN(5000)
REAL A(3,3),AMATZ(3,3),AMATINV(3,3),AMATINVZ(3,3),
$ DPS_TO_MOSFLM(3,3),MOSFLM_TO_DPS(3,3),XYZ2HKL(3,3),
$ WAVMAT(3,3),MIS_SET(3),URFX(3,3),MOSFLM_TO_RFX(3,3),
$ XYZ(3),FHKL(3),DETA,DA,BMATINV(3,3),SAVAMAT(3,3)
INTEGER SAVNUMSPG,SAVICRYST
REAL FDUM,OMEGAF,PHIDUM,DTOR
REAL FR_MAT(2,2)
REAL ROTMAT(3,3),ROTMATINV(3,3),HKL2XYZ(3,3)
INTEGER IMGCNT,IMGNOS(25,2)
DOUBLE PRECISION X_SQR,Y_SQR,DIST_SQR,DOUBLE_REC_LENGTH,
$ LAMBDA_INV
CHARACTER*40 DATNAM,OM_OUT_NAM,CHAR_LATT_NAM,
$ BRAV_SUMM_NAM
REAL CL_OM(3,3,45),CRIT(45)
CHARACTER*3 SYS_ID(45)
CHARACTER*70 SGLIST(44)
CHARACTER*23 LATT_NAME(15),LATTICE(44)
CHARACTER*10 SAVSPGNAM
REAL LATT_CRIT(15)
LOGICAL THRESHFLAG,NULINE
C
C Quantities only used if the 2-theta arm is swung on on some detectors
C
REAL COS2TH,SIN2TH,THETCOR
C .. Equivalences ..
SAVE
C ..
C .. Data ..
Cccc DATA NLAUEG/44/
parameter (nlaueg=44)
DTOR = ATAN(1.0)/45.0
C
C---- Flags for crystal classes
C
DATA LCLASS/-1,-1,-1,-1,-1,-1,
+ -1,-1,-1, 0,-1, 0,
+ -1,-1,-1, 0, 0, 0,
+ -1, 1,-1, 0, 0, 0,
+ -1, 1,-1, 0, 0, 0,
+ -1, 1,-1, 0, 0, 0,
+ -1, 1, 1, 0, 0, 0,
+ -1, 1, 1,-1, 4, 4/
DATA DPS_TO_MOSFLM /0.0,1.0,0.0, 0.0,0.0,1.0, 1.0,0.0,0.0/
DATA MOSFLM_TO_DPS /0.0,0.0,1.0, 1.0,0.0,0.0, 0.0,1.0,0.0/
DATA MOSFLM_TO_RFX /-1.0,0.0,0.0, 0.0,1.0,0.0, 0.0,0.0,-1.0/
DATA WAVMAT /1.0,0.0,0.0, 0.0,1.0,0.0, 0.0,0.0,1.0/
DATA LATT_NAME /
$ 'Triclinic ',
$ 'Primitive Monoclinic ',
$ 'C Centred Monoclinic ',
C!!!!!!! but we're not ignoring I centred monoclinic!
$ 'I Centred Monoclinic ',
$ 'Primitive Orthorhombic ',
$ 'C Centred Orthorhombic ',
$ 'F Centred Orthorhombic ',
$ 'I Centred Orthorhombic ',
$ 'Primitive Tetragonal ',
$ 'I Centred Tetragonal ',
C!!!!!!! $ 'Primitive Rhombohedral ', ! we're ignoring rP!
$ 'Primitive Hexagonal ',
$ 'R Centred Hexagonal ',
$ 'Primitive Cubic ',
$ 'F Centred Cubic ',
$ 'I Centred Cubic '
$/
DATA LTYPE/'aP','mP','mC','mI','oP','oC','oF','oI','tP','tI',
+ 'hP','hR','cP','cF','cI'/
DATA SPLIST/'P1','P2,P21','C2','C2','P222,P2221,P21212,P212121',
+ 'C222,C2221','F222','I222,I212121,',
+ 'P4,P41,P42,P43,P422,P4212,P4122,P41212,P4222,P42212',
+ 'I4,I41,I422,I4122',
+ 'P3,P31,P32,P312,P321,P3112,P3121,P3212,P3221',
+ 'H3,H32 (hexagonal settings of R3 and R32)',
$ 'P23,P213,P432,P4232,P4332,P4132','F23,F432,F4132',
+ 'I23,I213,I432,I4132'/
DATA SPLISTB(1:30)/'P6,P61,P65,P62,P64,P63,P622,P6'/
DATA SPLISTB(31:57)/'122,P6522,P6222,P6422,P6322'/
DATA LATT_CRIT /999999.9,999999.9,999999.9,999999.9,999999.9,
$ 999999.9,999999.9,999999.9,999999.9,999999.9,
$ 999999.9,999999.9,999999.9,999999.9,999999.9/
SPLIST(9) = SPLIST(9)(1:52)//'P4322,P43212'
data nspot /5000/
C
C Data for the REFIX cell & orientation refinement
C
DATA ACHSE / 0.0,0.0,1.0 /
DATA ED / 0.0,1.0,0.0,0.0,0.0,1.0,1.0,0.0,0.0/
DATA REIDX0 / 1,4*0,1,4*0,1,0/
DATA S0L(2) / 0.0 / S0L(3) / 0.0 /
DATA SDCUTOFF / 2.5 /
DATA USERDMAX /.FALSE./ USERCELL /.FALSE./ STARTLIST /.TRUE./
c DATA IBEAM / 0 / XCOR / 0.0 / YCOR / 0.0 /
LAMBDA_INV = 1.0/WAVE
THRESHFLAG = .FALSE.
RASTY = RAST * YSCAL
C______________________________________________________________________________
C ISPOT, IDATA, OM_OUT, COUNT: Logical unit numbers for various IO units
C ITEST(15): Sequence Number for each of the 14 Bravais Lattices
C CCP4 routines:
C Test digit for CCPDPN, length of STRING
C
C IMAGE DATA
C XBEAM, YBEAM, co-ordinates of the direct beam in mm
C XSPT, YSPT " " " diffraction spots in mm
C XTEMP, YTEMP temporary variables used during reduction of XSPT and YSPT
C to correct detector orientation.
C
C X,Y,Z reciprocal space co-ordinates of each spot.
C RESMIN, RESMAX minimum and maximum resolution for this run
C DMAX maximum cell edge to be considered
C A, AMAT A and UB matrices; A is the UB matrix from DPS, but it
C differs from the MOSFLM UB matrix in that it doesn't contain
C the wavelength, and *it's from C*, so the fast and slow
C directions are swapped, i.e. it's the wavelength-independent
C transpose.
C CELL(6): a, b, c, alpha, beta, gamma of possible cells
C FDUM: floating point dummy parameter, used for swapping REALs.
C PHI,PHIBEG,PHIEND: crystal oscillation start, end and mid-point.
C INVERTX: Detector inversion parameter
C OMEGAFD: orientation angle of detector (90 normally) (OMEGAF is in
C radians)
C FR_MAT(2,2): calculated from invertx and OMEGAF for DPS
C DISTANCE,WAVELENGTH: crystal to detector distance, wavelength
C ROTMAT: rotation matrix for conversion of image co-ords to reciprocal space
C co-ords
C X_SQR, Y_SQR, DOUBLE_REC_LENGTH, LAMBDA_INV are used in the resolution
C cutting.
C
C IDENT,SPTNAM,DATNAM,OM_OUT_NAM,CHAR_LATT_NAM,BRAV_SUMM_NAM : filenames
C
C CL_OM(3,3,45): orientation matrices for the 44 Characteristic Lattices
C MERIT(45): quality criterion for each of CL_OM
C SYS_ID(45): Bravais Lattice, for each CL e.g. aP = anorthic Primitive
C LTYPE(15): the 14 Bravais Lattices (see SYS_ID(45))
C SPLIST,SGLIST: the space groups for each Bravais lattice
C SPLISTB: if we want rhombohedral space group, here are the names.
C LATT_NAME(15),LATTICE(44): " " " " by name.
C LATT_CRIT(15): FoM for the "best" solution for each Bravais Lattice.
C I,J,K: normal counters for loops, etc.
C========================================================================
C
C
C---- if solution has been chosen from a list generated below, we need
C to make sure the spacegroup information is correct
C
IF((NSOL.GE.101).AND.(NSOL.LE.144))THEN
J = IRESORDER(NSOL-100)
BTSTR = BT(J)
LATTYP = BTSTR(2:2)
C
C---- triclinic ("anorthic")
C
IF (BTSTR(1:1).EQ.'a')THEN
NUMSPG = 1
C
C---- monoclinic
C
ELSEIF (BTSTR(1:1).EQ.'m')THEN
NUMSPG = 3
C
C---- orthorhombic
C
ELSEIF (BTSTR(1:1).EQ.'o')THEN
NUMSPG = 16
C
C---- tetragonal
C
ELSEIF (BTSTR(1:1).EQ.'t')THEN
NUMSPG = 75
C
C---- trigonal or hexagonal - use P6
C
ELSEIF (BTSTR(1:1).EQ.'h')THEN
IF (BTSTR.EQ.'hR')THEN
NUMSPG = 146
ELSE
NUMSPG = 168
ENDIF
C
C---- cubic
C
ELSEIF (BTSTR(1:1).EQ.'c')THEN
NUMSPG = 196
ENDIF
C
C----
C
NSOL = NSOL -100
ENDIF
C---- Skip if rhombohedral cell has been requested by CRYST keyword;
C---- we don't do this yet for DPS indexing
C
IF (ICRYST.EQ.8) GOTO 100
C
C
C---- Triclinic
C
IF (NUMSPG.LT.3) THEN
ICRYST = 1
ICS = 1
C
C---- Monoclinic
C
ELSE IF (NUMSPG.LT.16) THEN
ICRYST = 2
ICS = 3
C
C---- Orthorhombic
C
ELSE IF (NUMSPG.LT.75) THEN
ICRYST = 3
ICS = 4
C
C---- Tetragonal
C
ELSE IF (NUMSPG.LT.143) THEN
ICRYST = 4
ICS = 5
C
C---- Trigonal, but allow for rhombohedral settings (CRYST keyword)
C
ELSE IF (NUMSPG.LT.168) THEN
IF (ICRYST.NE.8) THEN
ICRYST = 5
ICS = 7
ENDIF
C
C---- Hexagonal
C
ELSE IF (NUMSPG.LT.195) THEN
ICRYST = 6
ICS = 7
C
C---- Cubic
C
ELSE IF (NUMSPG.LE.230) THEN
ICRYST = 7
ICS = 8
END IF
C
C---- Also set systematic absence flags and cell refinement flags
C
C
C---- Set cell refinement flags
C
100 CONTINUE
DO 110 I = 1,6
LCELL(I) = LCLASS(I,ICRYST)
110 ENDDO
C
C---- Get lattice type from spacegroup name, but only if known SPG
C
IF((NUMSPG.GT.0).AND.(NUMSPG.LE.230))
$ CALL MMSYMLB(24,NUMSPG,SPGNAM,PGNAME,NSYMP,NSYM,RSYM,IERR)
LATTYP = SPGNAM(1:1)
C
C
ISYS = 2
IF (LATTYP.EQ.'A') THEN
KSYS(1) = 0
KSYS(2) = 1
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'B') THEN
KSYS(1) = 1
KSYS(2) = 0
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'C') THEN
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 0
ELSE IF (LATTYP.EQ.'I') THEN
ISYS = 2
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'H') THEN
C
C---- Allow for choice of rhombohedral cell, but this is straight from TOREFIX;
C Harry doesn't let us do this. The 'ICRYST.EQ.8' bit should never
C be executed
C
IF (ICRYST.EQ.8) THEN
ISYS = 0
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
ELSE
ISYS = 3
KSYS(1) = -1
KSYS(2) = 1
KSYS(3) = 1
END IF
ELSE IF (LATTYP.EQ.'F') THEN
ISYS = 4
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'P') THEN
ISYS = 0
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
END IF
IF(LSOL)THEN
WRITE(IOUT,FMT=6503)SOLN
IF(ONLINE)WRITE(ITOUT,FMT=6503)SOLN
ENDIF
6503 FORMAT('Solution ',I2,' has been chosen from the list',
$ ' with the keywords "AUTOINDEX SOLUTION n"',/,
$ 'which override any user supplied cell parameters',/)
C
C---- If a solution has been chosen, pick the right UB matrix
C
IF ((ABS(NSOL).GT.0).AND.(ABS(NSOL).LE.44)) THEN
DO 120 I = 1,3
WAVMAT(I,I) = WAVE
120 ENDDO
I = IRESORDER(ABS(NSOL))
DO 140 K=1,3,1
DO 130 J=1,3,1
A(J,K) = CL_OM(J,K,I)
130 ENDDO
140 ENDDO
CALL MATMUL3(AMAT,WAVMAT,A)
CALL MATCOP(AMAT,AMATZ)
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
chrp20102000 ENDIF
IF(NSOL.GT.0)THEN
LLINE = ' '
WRITE(IOUT,FMT=6502)
if(online) WRITE(ITOUT,FMT=6502)
c socket IF(SOCKLO)THEN
c socket WRITE(IOLINE,FMT=6502)
c socket CALL WRITE_SOCKET(SERVERFD,0,IOLINE)
c socket ENDIF
IF(RFIXCELL)THEN
DO 105 I=1,6
CELL(I) = SCELL(I)
105 ENDDO
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
ICS = 0
END IF
IF(ONLINE.AND.WINOPEN)THEN
WRITE(IOLINE,FMT=6502)
CALL WINDIO(NULINE)
6502 FORMAT('The solution and direct beam position will ',
$ 'now be refined; reflections which ',
$ 'deviate by more',/,'than the sigma cutoff from',
$ ' their calculated position will be excluded ',
$ 'from the refinement.',/)
WRITE(LLINE,FMT=6501)
6501 FORMAT(' ')
CALL MXDWIO(LLINE, 0)
C
C---- sigma cutoff in refinement
C
WRITE(LLINE,FMT=6500)SDCUTOFF
6500 FORMAT('Positional sigma cutoff [',F5.2,']: ')
CALL MXDWIO(LLINE, 1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
IF (NTOK.EQ.1) THEN
IF (ITYP(1).EQ.2) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
IF((VALUE(1).GT.99.9).OR.(VALUE(1).LE.0.0))THEN
VALUE(1) = SDCUTOFF
INDNOREF = .TRUE.
WRITE(LLINE,FMT=6505)SDCUTOFF
6505 FORMAT('**** WARNING **** SIGMA CUTOFF',
$ ' UNREASONABLE. RESET TO ',F5.2)
CALL MXDWIO(LLINE, 3)
ELSE
SDCUTOFF = VALUE(1)
INDNOREF = .FALSE.
ENDIF
ENDIF
ELSE
INDNOREF = .FALSE.
ENDIF
LLINE = ' '
WRITE(LLINE,FMT=6505)SDCUTOFF
ENDIF
ENDIF
IF(.NOT.INDNOREF) THEN
WRITE(IOUT,FMT=6510)ABS(NSOL),SPGNAM,NUMSPG
IF (ONLINE) WRITE(ITOUT,FMT=6510)ABS(NSOL),SPGNAM,NUMSPG
WRITE(LLINE,FMT=6510)ABS(NSOL),SPGNAM,NUMSPG
6510 FORMAT('Refining solution #',I2,' with ',A7,'(number ',I3,
$ ') symmetry ',
+ 'imposed')
IF (ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 2)
NBAD(2) = 0
NBAD(3) = 0
C
C---- need to do this for outputting CELL
C
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
call cellfix(CELLB(1,IRESORDER(ABS(NSOL))))
WRITE(IOUT,FMT=6504)(CELLB(II,IRESORDER(ABS(NSOL))),II=1,6)
IF(ONLINE)WRITE(ITOUT,FMT=6504)
$ (CELLB(II,IRESORDER(ABS(NSOL))),II=1,6)
6504 FORMAT(/,'Initial cell (before refinement) is ',3(F9.4,1X),
$ 3(F7.3,1X))
DO 191 II = 1,6
SDCELL(II) = 0.0
191 ENDDO
SDPHI = 0.5
SDXY = 1.0
ORGX = 0.0
ORGY = 0.0
DO 190 II = 1,4
NBAD(1) = 0
IF(II.GT.1)THEN
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
ENDIF
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C
C================================================================
C--- calculate list of reflections from internal co-ordinates
C
C
C--- invert the A (=UB) matrix
C
CALL MINV33(AMATINV,AMAT,DA)
C
C--- remember that X(I), Y(I) and Z(I) were calculated according to DPS setting
C
CALL MATMUL3(AMATINVZ,AMATINV,DPS_TO_MOSFLM)
C
C--- Correct AMATINV for wavelength
C
CALL MATMUL3(AMATINV,AMATINVZ,WAVMAT)
MEANERR = 0.0
DO 160 I=1,COUNT
XYZ(1) = X(I)
XYZ(2) = Y(I)
XYZ(3) = Z(I)
C
C--- and convert to Miller indices
C
CALL MATVEC(FHKL,AMATINV,XYZ)
C
C--- Pick closest Miller index to this reciprocal space co-ordinate
C
IH(I) = NINT(FHKL(1))
IK(I) = NINT(FHKL(2))
IL(I) = NINT(FHKL(3))
REFLERR(I) = SQRT( (FHKL(1)-IH(I))**2
$ + (FHKL(2)-IK(I))**2 + (FHKL(3)-IL(I))**2 )
MEANERR = MEANERR + REFLERR(I)
C
C---
C
IPHI(I) = NINT(100*PHIMEAN(I))
160 ENDDO
MEANERR = MEANERR/COUNT
SUMSQDIFF = 0.0
DO 170 I=1,COUNT
SUMSQDIFF = SUMSQDIFF+(REFLERR(I)-MEANERR)**2
170 ENDDO
SUMSQDIFF = SDCUTOFF*(SQRT(SUMSQDIFF/COUNT))
DO 180 I = 1,COUNT
IF(ABS(MEANERR-REFLERR(I)).GT.SUMSQDIFF)THEN
IH(I) = 0
IK(I) = 0
IL(I) = 0
NBAD(1) = NBAD(1) + 1
ENDIF
180 ENDDO
C
C to refine the cell, orientation and distance properly, the next few bits of
C code are included.
C
NCYCLE = 6
IERR = 0
S0L(1) = LAMBDA_INV
C
C set parameters for refinement
C
IF (RFIXDIST)THEN
C
C---- tie everything up if this is the first cycle for triclinic
C
c IF(NUMSPG.LT.3)THEN
c IF(II.EQ.1)THEN
c ICS = 1
c IC = 7
c ELSE
c ICS = 1
c IC = 5
c ENDIF
c ELSE
IC = 5
c ENDIF
ELSE
IC = 4
ENDIF
C
C---- save original cell edges for the chosen symmetry
C
IF(.NOT.LSOL.AND.(KCELL(1).GT.0.0).and..not.RFIXcell
$ .and.(KCELL(2).GT.0.0).and.(KCELL(3).GT.0.0))THEN
CELLS(1) = KCELL(1)
CELLS(2) = KCELL(2)
CELLS(3) = KCELL(3)
ELSE
CELLS(1) = CELL(1)
CELLS(2) = CELL(2)
CELLS(3) = CELL(3)
ENDIF
C
C--- use reciprocal cell with A-1 units, not dimensionless
C
CALL RECCEL(RCELL,CELL,1.0)
C
C--- need BMAT according to REFIX orthogonalization
C
CALL RFBMAT(BMAT,RCELL,WAVE)
CALL MINV33(BMATINV,BMAT,DA)
CALL MATMUL3(UMAT,AMAT,BMATINV)
NREF = COUNT
IF(DEBUG(70))THEN
6520 FORMAT(72('-'),/,'NCYCLE = ',I2,/,'REIDX0 = ',4I2,
$ 2(/,9X,4I2),/,'NREF = ',I5,/,'ACHSE = ',3F5.2,/,
$ 'IC = ',I2,' ICS = ',I2,' RAST = ',F8.4,/,
$ 'ORGX = ',F8.2,' ORGY = ',F8.2,' XTD = ',
$ F8.2,/,'S0L = ',3F12.6,/,'ED = ',3F5.2,2(/,
$ 5X,3F5.2),/,'UMAT = ',3F10.6,2(/,7X,3F10.6),/,
$ 'RCELL = ',3(F9.7,1X),3(F9.4,1X),/,'CELL = ',
$ 6(F9.4,1X),/,'SDU = ',F10.6,/,'SDCELL = ',
$ 6F10.4,/,'SDPHI = ',F10.6,' SDXY = ',F10.6,
$ ' SDCUTOFF = ',F6.2,' IERR = ',I4,/,
$ 72('='),/)
IF(ONLINE)WRITE(ITOUT,*)'CELREF OUTER CYCLE: ',II
IF(ONLINE)WRITE(ITOUT,6520)NCYCLE,REIDX0,NREF,ACHSE,
$ IC,ICS,RAST,ORGX,ORGY,XTD,S0L,((ED(I,J),J=1,3),
1 I=1,3),((UMAT(I,J),J=1,3),I=1,3),RCELL,CELL,SDU,
+ SDCELL,SDPHI,SDXY,SDCUTOFF,IERR
WRITE(IOUT,*)'CELREF OUTER CYCLE: ',II
WRITE(IOUT,6520)NCYCLE,REIDX0,NREF,ACHSE,IC,ICS,
$ RAST,ORGX,ORGY,XTD,S0L,((ED(I,J),J=1,3),I=1,3),
1 ((UMAT(I,J),J=1,3),I=1,3),RCELL,CELL,SDU,SDCELL,
+ SDPHI,SDXY,SDCUTOFF,IERR
ENDIF
CALL CELREF(NCYCLE,REIDX0,NREF,IH,IK,IL,IXD,IYD,IPHI,
$ ACHSE,IC,ICS,RAST,
$ ORGX,ORGY,XTD,S0L,ED,UMAT,RCELL,SDU,SDCELL,SDPHI,
+ SDXY,SDCUTOFF,NBAD,IERR)
IF(DEBUG(70))THEN
CALL RECCEL(CELL,RCELL,1.0)
IF(ONLINE)WRITE(ITOUT,*)'CELREF out '
IF(ONLINE)WRITE(ITOUT,6520)NCYCLE,REIDX0,NREF,ACHSE,
$ IC,ICS,RAST,ORGX,ORGY,XTD,S0L,((ED(I,J),J=1,3),
1 I=1,3),((UMAT(I,J),J=1,3),I=1,3),RCELL,CELL,SDU,
+ SDCELL,SDPHI,SDXY,SDCUTOFF,IERR
WRITE(IOUT,*)'CELREF out '
WRITE(IOUT,6520)NCYCLE,REIDX0,NREF,ACHSE,IC,ICS,
$ RAST,ORGX,ORGY,XTD,S0L,((ED(I,J),J=1,3),I=1,3),
1 ((UMAT(I,J),J=1,3),I=1,3),RCELL,CELL,SDU,SDCELL,
+ SDPHI,SDXY,SDCUTOFF,IERR
ENDIF
C
C--- Check to make sure the number of reflections used was reasonable
C
IF((IERR .EQ. 0) .OR. (NBAD(1) .EQ. NREF))THEN
LINE = ' '
WRITE(LINE,6930)
IF (ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(LINE,6860)
WRITE(IOUT,6860)
IF(ONLINE)WRITE(ITOUT,6860)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(LINE,6870)
WRITE(IOUT,6870)
IF(ONLINE)WRITE(ITOUT,6870)
IF (ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(IOLINE,6880)SDCUTOFF
WRITE(IOUT,6880)SDCUTOFF
IF(ONLINE)WRITE(ITOUT,6880)SDCUTOFF
IF(ONLINE.AND.WINOPEN)CALL WINDIO(NULINE)
6860 FORMAT(2('***** FATAL ERROR IN REFINEMENT '),'*****')
6870 FORMAT(5X,10('*'),' ALL REFLECTIONS HAVE BEEN ',
$ 'FLAGGED ''BAD'' ',10('*'))
6880 FORMAT('i.e. they all deviate by more than ',F3.1,
$ ' sigma from their calculated positions.',/,
$ 'Try setting the sigma cutoff to a larger value',
$ ' or choosing another solution.',/,
$ 'If that fails, try indexing with more ',
$ 'reflections.')
C
C--- We MUST jump out of the loop if IERR = 0!!
C
GOTO 195
ENDIF
IF (.NOT. RFIXDIST)XTOFD = 100.0*XTD*COS2TH
C
C--- next bits to extract MOSFLM AMAT from REFIX UMAT and RCELL...
C (SETMAT doesn't work as orthogonalization of BMAT in CELREF is _not_ the
C same as in MOSFLM)
CALL RFBMAT(BMAT,RCELL,WAVE)
CALL MATMUL3(AMAT,UMAT,BMAT)
CALL RECCEL(CELL,RCELL,1.0)
190 ENDDO
IF ((NBAD(1).GE.4*NREF/5).AND.(NBAD(2).EQ.0))THEN
NBAD(2) = NBAD(2) + 1
6930 FORMAT(' ')
WRITE(LINE,6930)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(LINE,6920)
WRITE(IOUT,6920)
IF(ONLINE)WRITE(ITOUT,6920)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,3)
WRITE(IOLINE,6940)NBAD(1),NREF,SDCUTOFF
WRITE(IOUT,6940)NBAD(1),NREF,SDCUTOFF
IF(ONLINE)WRITE(ITOUT,6940)NBAD(1),NREF,SDCUTOFF
IF(ONLINE.AND.WINOPEN)CALL WINDIO(NULINE)
6920 FORMAT('***** WARNING ***** REFINING WITH LESS ',
+ 'THAN TWENTY PERCENT OF THE REFLECTIONS.')
6940 FORMAT(I4,' out of ',I4,' reflections have been ',
$ 'flagged as ''bad'' (i.e. they deviate by more ',
$ /,'than ',F3.1,' sigma from their calculated ',
$ 'positions.)',/,
$ 'The refinement will probably not be ',
$ 'reliable; you should set the sigma cutoff ',/,
$ 'to a higher value or consider choosing a ',
$ 'different solution. If the problem persists,',/,
$ ' you should reindex without refinement.')
ELSE
IF ((NBAD(1).GE.NREF/2).AND.(NBAD(2).EQ.0)
$ .AND.(NBAD(3).EQ.0))THEN
NBAD(3) = NBAD(3) + 1
WRITE(LINE,6930)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(IOUT,6960)
IF(ONLINE)WRITE(ITOUT,6960)
WRITE(LINE,6960)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,3)
6960 FORMAT('***** WARNING ***** REFINING WITH LESS ',
+ 'THAN FIFTY PERCENT OF THE REFLECTIONS.')
WRITE(IOUT,6980)NBAD(1),NREF,SDCUTOFF
IF(ONLINE)WRITE(ITOUT,6980)NBAD(1),NREF,SDCUTOFF
WRITE(IOLINE,6980)NBAD(1),NREF,SDCUTOFF
IF(ONLINE.AND.WINOPEN)CALL WINDIO(NULINE)
6980 format (I4,' out of ',I4,' reflections have been ',
$ 'flagged as ''bad'' (i.e. they deviate by ',
$ 'more',/,'than ',F3.1,' sigma from their ',
$ 'calculated positions.)',/,
$ 'The refinement may not be reliable; you ',
$ 'should check the predicted fit carefully ',
$ 'and',/,'set the sigma cutoff to a higher ',
$ 'value if the fit is unreasonable. If the ',
$ 'problem persists,',/,'you should consider ',
$ 'reindexing without refinement.')
ENDIF
ENDIF
195 IF(IERR.EQ.0)THEN
CALL MATMUL3(AMATZ,WAVMAT,A)
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
INDNOREF = .TRUE.
WRITE(LINE,6930)
IF (ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(LLINE,FMT=6528)
WRITE(IOUT,FMT=6528)
IF(ONLINE)WRITE(ITOUT,FMT=6528)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 3)
6528 FORMAT(10X,'***** ORIGINAL MATRIX BEING RESTORED *****')
ENDIF
ELSE
C
C--- Solution not being refined
C
CALL MATMUL3(AMATZ,WAVMAT,A)
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
WRITE(LLINE,FMT=6530)
WRITE(IOUT,FMT=6530)
IF(ONLINE)WRITE(ITOUT,FMT=6530)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 3)
6530 FORMAT('Autoindex solution NOT being refined!')
ENDIF
C
C Call to get the axial order the user wanted...
C
IF(.NOT.RFIXCELL)CALL PERMUTATE(CELL,AMAT,ICRYST,LATTYP)
chrp23082001 IF (ONLINE.AND.WINOPEN)THEN
IF(.NOT.INDNOREF)THEN
WRITE(LLINE,FMT=6540)IERR,COUNT,SDCUTOFF
WRITE(IOUT,FMT=6540)IERR,COUNT,SDCUTOFF
IF(ONLINE)WRITE(ITOUT,FMT=6540)IERR,COUNT,SDCUTOFF
6540 FORMAT('Using',I5,' indexed reflections (out of ',I4,
$ ' spots found, {delta(XY) <= ',F3.1,' sigma}),')
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 3)
WRITE(LLINE,FMT=6550)RAST*SDXY,SDPHI
WRITE(IOUT,FMT=6550)RAST*SDXY,SDPHI
IF(ONLINE)WRITE(ITOUT,FMT=6550)RAST*SDXY,SDPHI
6550 FORMAT('final sd in spot positions is',F5.2,
+ 'mm and in phi',F5.2,' degrees')
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 2)
IF (.NOT.RFIXDIST) THEN
WRITE(LLINE,FMT=6560)XTD
WRITE(IOUT,FMT=6560)XTD
IF(ONLINE)WRITE(ITOUT,FMT=6560)XTD
6560 FORMAT('Refined detector distance',F8.2,'mm')
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 2)
c LLINE = ' '
END IF
IF (RFIXCELL) THEN
IF(ONLINE)WRITE(ITOUT,FMT=6570) (CELL(I),I=1,6)
WRITE(IOUT,FMT=6570) (CELL(I),I=1,6)
WRITE(LLINE,FMT=6570) (CELL(I),I=1,6)
6570 FORMAT('Cell parameters (fixed)',3F8.2,3F7.2)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 2)
ICELL = 1
ELSE
WRITE(IOUT,FMT=6580) (CELL(I),I=1,6)
IF(ONLINE)WRITE(ITOUT,FMT=6580) (CELL(I),I=1,6)
WRITE(LLINE,FMT=6580) (CELL(I),I=1,6)
6580 FORMAT('Refined cell parameters',3F8.2,3F7.2)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 2)
ENDIF
C
C---- if the cell edges have changed dramatically in the refinement, the
C user should be warned and the update should not be the default!
C
STR1 = 'Y'
DO 185 I=1,3,1
IF(KCELL(I).GT.0.0)THEN
CELLCH(I) = CELLS(I)/KCELL(I)
ELSE
CELLCH(I) = CELLS(I)/CELL(I)
ENDIF
IF (CELLCH(I) .LT. 1)CELLCH(I) = 1.0/CELLCH(I)
IF (CELLCH(I).GT.1.05)THEN
STR1 = char(64 + I)
MISMATCH = (INT(CELLCH(I)) - 1)*100
LLINE = ' '
IF(KCELL(I).GT.0.0)THEN
WRITE(IOUT,FMT=6584)STR1,CELLS(I),MISMATCH,
$ KCELL(I)
IF(ONLINE)
$ WRITE(ITOUT,FMT=6584)STR1,CELLS(I),
$ MISMATCH,KCELL(I)
WRITE(LLINE,FMT=6584)STR1,CELLS(I),MISMATCH,
$ KCELL(I)
ELSE
WRITE(IOUT,FMT=6584)STR1,CELLS(I),MISMATCH,
$ CELL(I)
IF(ONLINE)
$ WRITE(ITOUT,FMT=6584)STR1,CELLS(I),
$ MISMATCH,CELL(I)
WRITE(LLINE,FMT=6584)STR1,CELLS(I),MISMATCH,
$ CELL(I)
ENDIF
6584 FORMAT('ORIGINAL CELL EDGE ',A1,' (',
$ F7.2,'A)',' DIFFERS BY MORE THAN ',I5,'% ',
$ 'FROM REFINED VALUE (',F12.2,'A). ')
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 1)
ENDIF
185 ENDDO
IF(STR1.NE.'Y')THEN
STR1 = 'N'
WRITE(IOUT,FMT=6585)
IF(ONLINE)WRITE(ITOUT,FMT=6585)
WRITE(IOLINE,FMT=6585)
6585 FORMAT(94('*'),/,'The ',
$ 'refinement is apparently rather unstable',
$ ', perhaps because it only uses low',
$ ' resolution data', /,'or one axis is ',
$ 'nearly parallel with the incident beam,',
$ ' or you have chosen a bad ',
$ 'solution.',/,94('-'),/,
$ 'YOU SHOULD UPDATE ONLY WITH CAUTION!',/,
$ 94('*'))
IF(ONLINE.AND.WINOPEN)CALL WINDIO(NULINE)
ENDIF
c LLINE = ' '
WRITE(LLINE,FMT=6590)STR1
6590 FORMAT('Do you want to update cell parameters (',1A,'):')
IF(NSOL.GT.0)THEN
IF(ONLINE.AND.WINOPEN)THEN
CALL MXDWIO(LLINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.NE.0) THEN
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
ENDIF
ELSE
C
C---- don't refine if big cell differences in background indexing
C
STR1 = 'N'
ENDIF
IF (STR1.EQ.'N') THEN
ICELL = 1
C
C--- Solution not being refined
C
CALL MATMUL3(AMATZ,WAVMAT,A)
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
ELSE
ICELL = 0
END IF
C
C--- rough calculation of minimum spot separation on image
C
IF(RCELL(1).LT.RCELL(2))THEN
MINSPLIT=RCELL(1)
ELSE
IF (RCELL(2).LT.RCELL(3))THEN
MINSPLIT = RCELL(2)
ELSE
MINSPLIT = RCELL(3)
ENDIF
ENDIF
MINSPLIT = WAVE*XTD*MINSPLIT
C
C--- Check shift in beam position and output it with a warning if it's big
C
XTEMP = (ORGX*RAST/COS2TH)
YTEMP = ORGY*RAST*(XTD-(XTEMP*SIN2TH))/XTD
Chrp $ + (RFTOFF*SPSI)+(RFROFF*CPSI)
Chrp XTEMP = XTEMP-(RFTOFF*CPSI)+(RFROFF*SPSI)
XCOR = XTEMP*FR_MAT(1,1) + YTEMP*FR_MAT(2,1)
YCOR = XTEMP*FR_MAT(1,2) + YTEMP*FR_MAT(2,2)
XTEMP = SQRT(XCOR**2+YCOR**2)
YTEMP = XTEMP/MINSPLIT
WRITE(LINE,6930)
IF (ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,2)
WRITE(LINE,FMT=6523)XBEAM,YBEAM,XBEAM+XCOR,YBEAM+YCOR
WRITE(IOUT,FMT=6523)XBEAM,YBEAM,XBEAM+XCOR,YBEAM+YCOR
IF (ONLINE)WRITE(ITOUT,FMT=6523)
$ XBEAM,YBEAM,XBEAM+XCOR,YBEAM+YCOR
IF (ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,3)
1346 STR1 = 'Y'
IF (XTEMP.GT.0.250*MINSPLIT)THEN
WRITE(LINE,FMT=6525)
WRITE(IOUT,FMT=6525)
IF(ONLINE)WRITE(ITOUT,FMT=6525)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LINE,3)
WRITE(LINE,FMT=6531)
STR1 = ' '
ELSE
WRITE(LINE,FMT=6529)STR1
ENDIF
WRITE(IOUT,6527)XTEMP,YTEMP,MINSPLIT
IF(ONLINE)WRITE(ITOUT,6527)XTEMP,YTEMP,MINSPLIT
WRITE(IOLINE,6527)XTEMP,YTEMP,MINSPLIT
IF(ONLINE.AND.WINOPEN)CALL WINDIO(NULINE)
6523 FORMAT('Beam coordinates of ',F6.2,1X,F6.2,' have',
$ ' been refined to ',F6.2,1X,F6.2)
6525 FORMAT(2('***** WARNING ***** WARNING ***** WARNING '))
6527 FORMAT(
$ 'This is a shift of ',F5.2,'mm or ',F6.3,' times ',
$ 'the minimum spot separation of ca ',F5.2,'mm.')
c WRITE(LINE,FMT=6529)STR1
IF(ONLINE.AND.WINOPEN)THEN
CALL MXDWIO(LINE,1)
6529 FORMAT('Do you want to accept the ',
$ 'new direct beam position? (',A1,') :')
6531 FORMAT('Do you want to accept the ',
$ 'new direct beam position? (answer Y or N!) :')
CALL MXDRIO(LINE2)
ENDIF
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.NE.0)THEN
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'N') THEN
XCOR = 0.0
YCOR = 0.0
ELSEIF (STR1.NE.'Y')THEN
WRITE(IOLINE,6521)
IF(ONLINE.AND.WINOPEN)THEN
CALL WINDIO(NULINE)
6521 FORMAT('You MUST answer "Y" or "N"!')
GOTO 1346
ENDIF
END IF
IF(INVERTX)THEN
XCEN = 100*(NREC*RAST-XBEAM-XCOR)
ELSE
XCEN = 100*(XBEAM + XCOR)
ENDIF
YCEN = 100*(YBEAM + YCOR)*YSCAL
ELSE
LLINE = ' '
WRITE(LLINE,FMT=6600)(CELL(I),I=1,6)
6600 FORMAT('Cell parameters: ',3F8.2,3F7.2)
IF(ONLINE.AND.WINOPEN)CALL MXDWIO(LLINE, 1)
END IF
chrp23082001 ENDIF
CAL
CAL Add code to refer solution to previously obtained AMATRIX (if any)
CAL to avoid getting symmetry related solutions for different images.
CAL
CAL
IF (TARGET) THEN
DO 196 I = 1,6
TARCELL(I) = CELL(I)
196 CONTINUE
IF (DEBUG(70)) THEN
WRITE(IOUT,FMT=6990) ((AMAT(I,J),J=1,3),I=1,3),
+ ((TMAT(I,J),J=1,3),I=1,3), TARCELL
IF (ONLINE) WRITE(ITOUT,FMT=6990)((AMAT(I,J),J=1,3),I=1,3),
+ ((TMAT(I,J),J=1,3),I=1,3), TARCELL
6990 FORMAT(//,1X,'CALLING TARGMAT',/,1X,'AMAT',/,3(1X,3F10.6,/),
+ /,1X,'TMAT',/,3(1X,3F10.6/),/,1X,'TARCELL',6F10.2)
END IF
CALL TARGMAT(AMAT,TMAT,TARCELL)
IF (DEBUG(70)) THEN
WRITE(IOUT,FMT=6992) ((AMAT(I,J),J=1,3),I=1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6992)((AMAT(I,J),J=1,3),I=1,3)
6992 FORMAT(//,1X,'AFTER TARGMAT AMAT',/,3(1X,3F10.6,/))
END IF
END IF
C
C--- write the UB matrix file
C
c CALL WRITE_UB_MATRIX(AMAT,UMAT,MIS_SET)
MATNUM = 12
LDUM = 80
IFAIL = 1
C
C---- Save this filename (in case a NEWMAT keyword is used)
C
SNEWMATNAM = NEWMATNAM
CALL CCPDPN(MATNUM,NEWMATNAM,'UNKNOWN','F',LDUM,IFAIL)
WRITE(MATNUM,FMT=6610)((AMAT(I,J),J=1,3),I=1,3),
$ ((UMAT(I,J),J=1,3),I=1,3),CELL
6610 FORMAT(3(3F12.8,/),3(7X,'0.000'),/,3(3F12.7,/),
$ 6F12.4,/,3(7X,'0.000'))
CLOSE (UNIT=MATNUM)
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
write(iout,fmt=6615)cell
if(online)write(itout,fmt=6615)cell
6615 format(' Final cell (after refinement) is ',3(F9.4,1X),
$ 3(F7.3,1X))
CAL
CAL
CAL Save this matrix as a possible target
CAL
DO 192 I = 1,3
DO 194 J = 1,3
TMAT(I,J) = AMAT(I,J)
194 CONTINUE
192 CONTINUE
TARGET = .TRUE.
C
C---- output the results in a format for the automation expert system (i.e.
C XML type...)
C
c socket
IF(SOCKLO)THEN
c socket
ioline2 = ' '
write(ioline2, fmt = 6911)
call write_socket_section(serverfd, lenstr(ioline2),
$ ioline2)
do i = 1, 44
j = iresorder(i)
ioline2 = ' '
write(ioline2, fmt = 6912) i, merit(j),
$ sys_id(j + 1)(1:2),
$ cellb(1, j), cellb(2, j), cellb(3, j),
$ cellb(4, j), cellb(5, j), cellb(6, j)
call write_socket_section(serverfd, lenstr(ioline2),
$ ioline2)
end do
ioline2 = ' '
write(ioline2, fmt = 6913)
call write_socket_length(serverfd, lenstr(ioline2),
$ ioline2)
WRITE(IOLINE2,FMT=6617) COUNT, IERR, COUNT - IERR,
$ SPGNAM, NSOL, CELL,
$ ((I, J, AMAT(I,J), I, J, J=1,3),I=1,3),
$ ((I, J, UMAT(I,J), I, J, J=1,3),I=1,3),
$ CELL, RAST*SDXY, XCOR, YCOR, XCOR + XBEAM,
$ YCOR + YBEAM, COUNT
c socket
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(ioline2),
$ IOLINE2)
c socket
ENDIF
c if on a socket, write the spotlist...
if(socklo) then
do i = 1, nspt
ipx = nint(xspt(i) / rast)
ipy = nint(yspt(i) * yscal / rast)
spot_position(2 * i - 1) = ipy
spot_position(2 * i) = ipx
end do
call write_spots(nspt, serverfd, spot_position)
end if
c 6617 format('','','',
c $ '',
c $ '',
c $ '',
c $ '',
c $ ' | ','',
c $ '',
c $ '',
c $ '',
c $ '','')
6911 format('',
$ '',
$ '',
$ 'ok')
6912 format('', I2, '',
$ I3, '', A, '',
$ f7.2, '', F7.2,'', F7.2,
$ '', F7.2, '', F7.2,
$ '', F7.2, ' | ',
$ '')
6913 format('')
6617 format('',
$ 'ok',
$ '', I4, '',
$ '', I4, '', I4, '',
$ '', A,
$ '', I2, '',
$ '', F7.2, '', F7.2,'', F7.2,
$ '', F7.2, '', F7.2,
$ '', F7.2, ' | ',
$ '', 3(3('', F11.8,
$ '')), '',
$ 3(3('', F11.8, '')),
$ '', F7.2, '', F7.2,'',
$ F7.2, '', F7.2, '', F7.2,
$ '', F7.2, ' | ',
$ '', F6.3, '',
$ '', F6.2, '',
$ F6.2, '', F6.2, '',
$ F6.2, '',
$ '', I4,'',
$ '')
C
C---- end of XML type output
C
RETURN
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
C
C back to the main graphics routine (MXDSPL) here if we've already
C chosen a solution.
C
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ENDIF
C
C---- if the user has input a cell but not a space group for background
C indexing we must stop here!
C
IF((NSOL.EQ.-999).AND.((CELL(1).NE.0).OR.(CELL(2).NE.0)
$ .OR.(CELL(3).NE.0).OR.(CELL(4).NE.0).AND.
$ (CELL(5).NE.0).OR.(CELL(6).NE.0)).AND.(NUMSPG.EQ.0))THEN
WRITE(IOUT,6618)
IF(ONLINE)WRITE(ITOUT,6618)
CALL SHUTDOWN
6618 FORMAT(4('***** SEVERE ERROR! '),/,'You have supplied a cell',
$ ' but no space group; this is not allowed! See the user',
$ /,'guide for more information')
ENDIF
IF (ONLINE.AND.WINOPEN.AND.(.NOT.BOXOPEN).AND.NSOL.EQ.0) THEN
C
C--- Create IO window
C
IXW = 200
IYW = 200
LINELEN = 100
NUMLIN = 10
CALL MXDCIO(0,LINELEN, NUMLIN, IXW,IYW)
BOXOPEN = .TRUE.
END IF
C WAVELENGTH = WAVE
C
C the film rotation matrix can be derived from OMEGAFD (defined elsewhere in
C in MOSFLM) and the INVERTX logical; we set FINVERTX to +1 for .NOT. invertx,
C -1 if INVERTX is true. if FINVERTX = 1, we have the normal
C MOSFLM conventions for SLOW and FAST axes. If FINVERTX = -1, the SLOW axis
C has been swapped in direction (and effectively the image is reflected
C through a vertical mirror plane).
C
C MOSFLM standards are: Xs slow, Ys fast, looking towards the X-ray source
C from the detector.
C Ys---> <---Xs
C ----- ^ ^ ----- ----- -----
C | || || | Xs|| | | ||Ys
C | || || | || | | ||
C | ||Xs Ys|| | || | | ||
C ----- ----- V ----- ----- V
C <----Ys Xs---->
C
C OMEGAFD = 0 90 180 270 = OMEGAFD
C
C and with Xs inverted;
C
C <----Ys Xs---->
C ----- ----- ^ ^ ----- -----
C | || | || || | Ys|| |
C | || | || || | || |
C | ||Xs | ||Ys Xs|| | || |
C ----- V ----- ----- V -----
C <----Xs Ys--->
C
C e.g. Mar images have OMEGAFD = 0, image inverted.
C Fuji " " " = 90, " ".
C
C ADXV standard is looking at the DISPLAY, regardless of where the X-ray beam is
C coming from or going to, SLOW is from top to bottom; FAST is from left to
C right. i.e. it matches DENZO.
C
FINVERTX = -1.0
IF (.NOT. INVERTX) FINVERTX = 1.0
FR_MAT(1,1) = COS(OMEGAF) * FINVERTX
FR_MAT(1,2) = SIN(OMEGAF)
FR_MAT(2,1) = -SIN(OMEGAF) * FINVERTX
FR_MAT(2,2) = COS(OMEGAF)
C
C
C top four lines of mosflm.spt files have fiducial information if the
C WRITE SPOTS option has been used; if the normal interactive spot search
C has been used, only have the top 3 lines
C
C It seems that the
C top line is "0.0000000E+00 0.0000000E+00" if there are four lines. We
C want to read these four lines anyway, but if XCEN and YCEN have been set
C already, we want to reset to the correct values.
C
COS2TH = COS(DTOR*(-TWOTHETA))
SIN2TH = SIN(DTOR*(-TWOTHETA))
RFROFF = ROFF*0.01
RFTOFF = TOFF*0.01
IF(XTOFD.GT.0.0)DISTANCE = XTOFD/100.0
XTD = DISTANCE/COS2TH
IFAIL = 1
200 CALL CCPDPN(ISPOT,SPTNAM,'READONLY','F',80,IFAIL)
IF (IFAIL .LT. 0) THEN
WRITE(*,*)SPTNAM(1:LENSTR(IDENT)+4),' does not exist. STOP'
IF(SOCKLO)THEN
WRITE(IOLINE2,FMT=6621)PROJECTNAME
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(ioline2),
$ IOLINE2)
ENDIF
6621 format('','','',
$ 'Spot file does not exist',
$ '')
IERRFLG = 1
CALL SHUTDOWN
ENDIF
REWIND (UNIT=ISPOT)
IMGCNT = 0
IMGNOS(1,1)=1
COUNT = 1
READ(ISPOT,*)XBEAM,YBEAM
IF ((XBEAM .EQ. 0.0) .AND. (YBEAM .EQ. 0.0)) THEN
J=3
ELSE
J=2
ENDIF
DO 210 I=1,J
READ(ISPOT,*)XBEAM,YBEAM
210 ENDDO
IF (DEBUG(70))THEN
WRITE(IOUT,FMT=6619)XBEAM,YBEAM,XMM(1),YMM(1)
IF (ONLINE) WRITE(ITOUT,FMT=6619)XBEAM,YBEAM,XMM(1),YMM(1)
6619 FORMAT('XBEAM, YBEAM for this image are: ',2F9.4,/
$ 'beam co-ordinates supplied previously are: ',2F9.4)
ENDIF
C
C---- next two lines make sure that beam position is as input, not as
C is given in spot file.
C
XBEAM = XMM(1)
YBEAM = YMM(1)
C
C---- Now get the spots
C
C First get the projection of the detector normal back the crystal from the
C direct beam position (ORGX, ORGY); this is used in the orientation/cell
C refinement at the end (vide supra).
C
220 READ (ISPOT,*,END=240)XTEMP,YTEMP,PHIDUM,
$ PHIMEAN(COUNT),THRESHOLD,SIGTHRESH
C
C Check for end of spots in file
C
IF ((XTEMP .EQ. -999.0) .AND.
$ (YTEMP .EQ. -999.0)) THEN
IMGCNT = IMGCNT+1
IMGNOS(IMGCNT,2)=COUNT
IMGNOS(IMGCNT+1,1)=COUNT+1
IF (DEBUG(70))THEN
WRITE(IOUT,FMT=6620)PHIMEAN(I)
IF (ONLINE) WRITE(ITOUT,FMT=6620)PHIMEAN(I)
ENDIF
GOTO 240
ENDIF
C
C check for end of frame if we have more than one;
C Ingo says that having more than one frame doesn't help, and can be harmful;
C this is not necessarily true!
C
IF ((XTEMP .LT. -98.0) .AND.
$ (YTEMP .LT. -98.0)) THEN
IMGCNT = IMGCNT+1
IMGNOS(IMGCNT,2)=COUNT
IMGNOS(IMGCNT+1,1)=COUNT+1
IF (DEBUG(70))THEN
WRITE(IOUT,FMT=6620)PHIMEAN(I)
IF (ONLINE) WRITE(ITOUT,FMT=6620)PHIMEAN(I)
ENDIF
6620 FORMAT('PHI angle for this image is ',F7.2)
DO 230 I=1,J+1
READ(ISPOT,*)XTEMP,XTEMP
230 ENDDO
GOTO 220
ENDIF
C
C trap for unreasonable values of threshold intensity and sigma...
C
IF ((THRESHOLD .LE. 0.0) .AND.
$ (SIGTHRESH .LE. 0.0)) GOTO 220
IF ((THRESHOLD/SIGTHRESH).LT.ITHRESH) GOTO 220
C
C convert to co-ordinates relative to beam and correct for film orientation.
C
C
C==============================================================================
XTEMP = XTEMP - XBEAM
YTEMP = YTEMP - YBEAM
X_SPOT(COUNT) = (XTEMP * FR_MAT(1,1)) +
$ (YTEMP * FR_MAT(1,2))
Y_SPOT(COUNT) = (XTEMP * FR_MAT(2,1)) +
$ (YTEMP * FR_MAT(2,2))
C
C--- correction for ROFF and TOFF
C
PSI = ATAN2(X_SPOT(COUNT),Y_SPOT(COUNT))
CPSI = COS(PSI)
SPSI = SIN(PSI)
X_SPOT(COUNT)=X_SPOT(COUNT)+RFTOFF*CPSI-RFROFF*SPSI
Y_SPOT(COUNT)=Y_SPOT(COUNT)-RFTOFF*SPSI-RFROFF*CPSI
CCCC
C---- IF detector is swung out (TWOTHETA arm) calculate coords. THETCOR is the
C angle between the X-ray beam and the spot projected down onto the XZ
C plane, measured from the crystal. We jump past this if twoth = 0
C to save a tiny bit of processing time.
C
IF (TWOTHETA.NE.0.0) THEN
THETCOR = (X_SPOT(COUNT)*COS2TH)/
$ (XTD-(X_SPOT(COUNT)*SIN2TH))
Y_SPOT(COUNT) = Y_SPOT(COUNT)*
$ (XTD/(XTD-(X_SPOT(COUNT)*SIN2TH)))
X_SPOT(COUNT) = XTD*THETCOR
ENDIF
IXD(COUNT) = NINT(X_SPOT(COUNT)*10.0/RAST)
IYD(COUNT) = NINT(Y_SPOT(COUNT)*10.0/RAST)
C
C increment counter
C
COUNT = COUNT + 1
GOTO 220
240 CONTINUE
COUNT = COUNT - 1
CLOSE (UNIT=ISPOT)
IF(COUNT.LE.0)THEN
IERRFLG = 1
IF(SOCKLO)THEN
WRITE(IOLINE2,FMT=6622)PROJECTNAME
CALL WRITE_SOCKET_LENGTH(SERVERFD,lenstr(ioline2),
$ IOLINE2)
ENDIF
6622 format('','','',
$ 'Spot file contains no spots',
$ '')
RETURN
ENDIF
DIST_SQR = XTD*XTD
C
C convert relative film co-ordinates to X, Y, Z in reciprocal space.
C
DO 250 I=1,COUNT
X_SQR = X_SPOT(I) * X_SPOT(I)
Y_SQR = Y_SPOT(I) * Y_SPOT(I)
DOUBLE_REC_LENGTH = SQRT(X_SQR + Y_SQR + DIST_SQR)
DOUBLE_REC_LENGTH = LAMBDA_INV/DOUBLE_REC_LENGTH
X(I) = DOUBLE_REC_LENGTH * X_SPOT(I)
Y(I) = DOUBLE_REC_LENGTH * Y_SPOT(I)
Z(I) = DOUBLE_REC_LENGTH * XTD - LAMBDA_INV
C
C We have to create a rotation matrix and multiply the vector
C [x(i),y(i),z(i)],
C
CALL ROTMATY_FROM_ANGLE(PHIMEAN(I),ROTMAT)
CALL MAT_VEC_MUL_3X3(ROTMAT,X(I),Y(I),Z(I))
IF (DEBUG(70).AND.(I.LE.NDEBUG(70)))THEN
WRITE(IOUT,FMT=6630)X_SPOT(I),Y_SPOT(I),IXD(I),IYD(I),
$ X(I),Y(I),
$ Z(I)
IF (ONLINE) WRITE(ITOUT,FMT=6630)X_SPOT(I),Y_SPOT(I),
$ IXD(I),IYD(I),X(I),
$ Y(I),Z(I)
ENDIF
6630 FORMAT(12X,2F12.2,1X,2I8,1X,3F12.6)
250 ENDDO
C
C---- set up parameters if this is a background run or unknown cell
C
IF((NSOL.EQ.0).OR.(NSOL.EQ.-999))THEN
C
C---- background run with user-supplied cell
C
IF((MAXCELL.GT.0.0).AND.(NSOL.EQ.-999))THEN
USERDMAX = .TRUE.
DMAX = MAXCELL
ENDIF
C
C---- all cell parameters must be positive for a known cell
C
IF((MAXCELL.LE.0.0).AND.(NUMSPG.GT.0).AND.
$ (NUMSPG.LE.230))THEN
IF((CELL(1).LE.0.0).OR.(CELL(2).LE.0.0).OR.
$ (CELL(3).LE.0.0).OR.(CELL(4).LE.0.0).OR.
$ (CELL(5).LE.0.0).OR.(CELL(6).LE.0.0))THEN
USERDMAX = .FALSE.
ELSE
USERDMAX = .TRUE.
MAXCELL = MAX(MAX(CELL(1),CELL(2)),CELL(3))
ENDIF
ENDIF
C
C---- background run with user-supplied cell
C
IF((MAXCELL.GT.0.0).AND.(NSOL.EQ.-999))THEN
USERDMAX = .TRUE.
DMAX = MAXCELL
ENDIF
IF((NUMSPG.GT.0).AND.(NUMSPG.LE.230))THEN
USERCELL = .TRUE.
BADUSERCELL = .FALSE.
PREREF = .FALSE.
SAVICRYST = ICRYST
SAVNUMSPG = NUMSPG
SAVSPGNAM = SPGNAM
DO 610 I=1,3
DO 605 J=1,3
SAVAMAT(I,J) = AMAT(I,J)
605 ENDDO
610 ENDDO
ELSE
USERCELL = .FALSE.
ENDIF
C
C---- spots must be at least 5 pixels apart to pass this test, but only do
C this test if user has not chosen a maximum cell edge yet.
C
IF(USERDMAX.AND.((NSOL.EQ.0).OR.NSOL.EQ.-999))THEN
MAXCELL = DMAX
ELSE
MINSEP = (RAST*MIN(medwxspot,medwyspot))
MAXCELL = DOUBLE_REC_LENGTH*MINSEP
MINCELL = 99999.9
DO 252 KI = 1,IMGCNT,1
DO 251 I = IMGNOS(KI,1),IMGNOS(KI,2)-1
DO 2510 J = IMGNOS(KI,1)+1,IMGNOS(KI,2)
INVCELL = SQRT
$ ((X(I)-X(J))**2+(Y(I)-Y(J))**2+
$ (Z(I)-Z(J))**2)
IF(INVCELL.GT.MAXCELL)THEN
MINCELL=MIN(MINCELL,INVCELL)
ENDIF
2510 ENDDO
251 ENDDO
252 enddo
MAXCELL = 1.0/MINCELL
ENDIF
mincell = xtd*lambda_inv
ELSE
USERDMAX = .TRUE.
ENDIF
C
C Call the indexing routine; this is straight from Ingo Steller with minor
C modification to allow for IERRFLG. Ingo's original dumped the program quite
C gracefully, but it looked like a crash!
C
IF(NSOL.EQ.0)THEN
IF(USERCELL)THEN
WRITE(IOUT,FMT=6800)CELL,SPGNAM,NUMSPG
IF(ONLINE)THEN
WRITE(ITOUT,FMT=6800)CELL,SPGNAM,NUMSPG
IF(WINOPEN)THEN
WRITE(IOLINE,FMT=6800)CELL,SPGNAM,NUMSPG
CALL WINDIO(NULINE)
ENDIF
ENDIF
6800 FORMAT('Autoindexing with user-supplied cell ',
$ 3(F8.3,1X),3(F6.2,1X),/,19X,'Space group ',A8,
$ 1X,' number ',I3)
DMAX = MAX(CELL(1),CELL(2),CELL(3))
ELSE
6326 FORMAT('Maximum expected cell edge (Angstroms) ['
$ ,i4,']: ')
IF (USERDMAX)THEN
WRITE(LINE,FMT=6326)nint(dmax)
ELSE
DMAX = max(maxcell,mincell)
WRITE(LINE,FMT=6326)nint(dmax)
ENDIF
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
IF (NTOK.EQ.1) THEN
IF (ITYP(1).EQ.2) THEN
CALL MKEYNM(1,1,LINE,IBEG,IEND,ITYP,NTOK)
C IF (IOERR) GOTO 1065
DMAX = VALUE(1)
USERDMAX=.true.
ENDIF
ENDIF
C
C---- do we want to pre-refine the solutions?
C
6328 FORMAT('Do you want to pre-refine the solutions? (N): ')
WRITE(LINE,FMT=6328)
CALL MXDWIO(LINE,1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'N'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.EQ.'Y') THEN
PREREF = .TRUE.
ELSE
PREREF = .FALSE.
END IF
ENDIF
WRITE(LINE,FMT=6038)
6038 FORMAT('Do you want to proceed (Y):')
CALL MXDWIO(LINE, 1)
CALL MXDRIO(LINE2)
C
C---- Parse reply
C
C ******************************************
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
C ******************************************
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.NE.'Y') THEN
CALL MXDCIO(1,0,0,0,0)
ierrflg = 2
return
END IF
C AL END IF
CALL XDLF_FLUSH_EVENTS(I)
CALL MXDBSY(0,'Autoindexing')
6640 FORMAT('DPS Indexing using ',i4,' reflections with I >= ',I3,
$ ' I/sigma(I)')
LLINE = ' '
IF(ONLINE.AND.WINOPEN)WRITE(LLINE,FMT=6640)COUNT,ITHRESH
WRITE(IOUT,FMT=6640)COUNT,ITHRESH
IF(ONLINE)WRITE(ITOUT,FMT=6640)COUNT,ITHRESH
IF (DEBUG(70))THEN
WRITE(IOUT,FMT=6650)TWOTHETA,COUNT,MINSEP,DMAX,XBEAM,
$ YBEAM
IF (ONLINE) WRITE(ITOUT,FMT=6650)TWOTHETA,COUNT,MINSEP,
$ DMAX,XBEAM,YBEAM
ENDIF
6650 FORMAT('DPS Indexing at Two-theta = ',f7.2,' with ',i4,
$ ' reflections (minimum spot separation = ',F4.2,
$ 'mm. Maximum expected cell edge ',f7.2,
$ ', Beam position is ',F7.2,1X,F7.2)
CALL MXDWIO(LLINE, 2)
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
IERRFLG = 0
ELSE
IF(.NOT.USERDMAX)DMAX = MAX(MAXCELL,MINCELL)
WRITE(IOUT,FMT=6650)TWOTHETA,COUNT,MINSEP,DMAX,XBEAM,YBEAM
IF (ONLINE) WRITE(ITOUT,FMT=6650)TWOTHETA,COUNT,MINSEP,DMAX,
$ XBEAM,YBEAM
ENDIF
CALL INDEX_FORTRAN(COUNT,X,Y,Z,DMAX*1.2,1,A,IERRFLG)
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
C--------------------------------------------------------------------
C
IF (IERRFLG .GT. 0)THEN
IF(NSOL.EQ.0)THEN
IF(ONLINE)WRITE(ITOUT,FMT=6657)
IF(ONLINE)WRITE(ITOUT,FMT=6655)minsep/2
LLINE = ' '
IF(ONLINE.AND.WINOPEN)then
WRITE(IOLINE,FMT=6657)
CALL WINDIO(NULINE)
LLINE = ' '
WRITE(IOLINE,FMT=6655)minsep/2
CALL WINDIO(NULINE)
LLINE = ' '
CALL MXDWIO(LLINE,1)
write (LLINE,FMT=6654)
CALL MXDWIO(LLINE,1)
CALL MXDRIO(LINE2)
CALL MXDCIO(1,0,0,0,0)
endif
WRITE(IOUT,FMT=6655)minsep/2
RETURN
ELSE
WRITE(IOUT,6656)
WRITE(IOUT,6655)minsep/2
ENDIF
ENDIF
6654 FORMAT('Press to proceed')
6657 FORMAT('The indexing process has failed. It may be worthwhile',
$ ' trying again with')
6656 FORMAT(/,'The indexing process has failed. You should try ',
$ 'again using the interactive',/,'display and considering',
$ ' the following changes to your input')
6655 FORMAT(' (i) a larger or smaller ',
$ 'longest cell edge (try the "Measure Cell" option),',/,
$ ' (ii) using more or fewer reflections ',
$ '(200 - 1000 is best),',
$ /,' (iii) using more and/or different images,',/,
$ ' or',/,' (iv) checking your direct beam position',
$ ' carefully',
$ ' (on these images it',/,' should be accurate',
$ ' to less than ',F4.2,'mm)',/)
IF (DEBUG(70))THEN
WRITE(IOUT,FMT=6660)A
IF (ONLINE) WRITE(ITOUT,FMT=6660)A
ENDIF
C
C
6660 FORMAT('Orientation matrix from DPS autoindexing is ',/,
$ 3(12X,3(F10.7,1X),/),/,'n.b. this does not include ',
$ 'wavelength information')
C
C Do the Bravais routines;
C
C using the routines in gui/condense_bravais; BRAVAIS.C has been modified
C locally to remove printf statements and return more than just an
C orientation matrix; other bits and pieces that it returns now are:
C
C orientation matrices for each of the characteristic lattices (C.L.s)
C quality criterion for each C.L.
C Bravais lattice type
C
C BRAVAIS_FORTRAN has been written as a local interface between the FORTRAN
C (MOSFLM) and the C (DPS) side of things; basically it just turns a matrix
C into a structure.
C
C You have to remember that C arrays go from 0 -> high-1, whereas Fortran's go
C from 1 -> high. A C array 0 -> 44, passed back to Fortran, will appear as
C 1 -> 45 to the Fortran program! So, to avoid problems that result from
C forgetting this, we shift everything by -1 on the index.
C
IERRFLG = 0
CALL BRAVAIS_FORTRAN(A,CL_OM,CRIT,SYS_ID,IERRFLG)
IF(IERRFLG.GT.0)THEN
IF(ONLINE)WRITE(ITOUT,6656)
IF(ONLINE)WRITE(ITOUT,6655)minsep/2
WRITE(IOUT,6656)
WRITE(IOUT,6655)minsep/2
RETURN
ENDIF
MERITMIN = 32767
MERITMAX = 0.0
DO 255 I = 1,45,1
IF (CRIT(I) .GT. MERITMAX)MERITMAX = CRIT(I)
255 ENDDO
DO 280 I=1,44,1
C
C CHANGE from SYS_ID(45)*3 to BT(44)*2 and CRIT(45) to MERIT(44) HEREC
C
BT(I) = SYS_ID(I+1)(1:2)
MERIT(I) = ABS(NINT(CRIT(I+1)*999.0/MERITMAX))
IF (MERIT(I) .LT. MERITMIN)MERITMIN = MERIT(I)
DO 270 J=1,3,1
DO 260 K=1,3,1
CL_OM(J,K,I) = CL_OM(J,K,I+1)
260 ENDDO
270 ENDDO
280 ENDDO
6670 FORMAT(
$ 'The DPS Autoindexing has a bug which sometimes causes ',
$ 'failure.',/,
$ 'The conditions which cause this problem can usually be'
$ ,/,
$ 'circumvented by changing the expected maximum cell edge ',
$ 'and/or',/,
$ 'the I/sig(I) threshold of spots used in indexing.')
IF ((MERITMIN .GT. 0).AND.(.NOT.THRESHFLAG)) THEN
THRESHFLAG = .TRUE.
IF (ONLINE) WRITE(ITOUT,FMT=6680) int(ITHRESH/2)
WRITE(IOUT,FMT=6680) int(ITHRESH/2)
IF(WINOPEN)THEN
WRITE(LINE,FMT=6680) INT(ITHRESH/2)
6680 FORMAT(80('-'),/1X,'Failed to index - decrease spot ',
+ 'intensity I/sig(I) threshold. Decreased to ',i4,/,
$ 80('='))
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR('Abort'),
+ 5,3,0,IBUTTON)
IF (IBUTTON.EQ.1)THEN
ITHRESH = INT(ITHRESH/2)
GOTO 200
ELSE
IERRFLG = 1
WRITE(ITOUT,FMT=6670)
RETURN
ENDIF
ELSE
ITHRESH = INT(ITHRESH/2)
GOTO 200
ENDIF
ENDIF
IF ((MERITMIN .GT. 0).AND.THRESHFLAG) THEN
THRESHFLAG = .FALSE.
IF (ONLINE) WRITE(ITOUT,FMT=6690) int(DMAX/0.6)
IF(WINOPEN)THEN
WRITE(LINE,FMT=6690)int(DMAX/0.6)
6690 FORMAT(80('-'),/,1X,'Failed to index - increase maximum '
& ,'expected cell edge to ',i4,/,80('='))
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR('Abort'),
+ 5,3,0,IBUTTON)
IF (IBUTTON.EQ.1)THEN
DMAX = DMAX * 2.0
GOTO 200
ELSE
IERRFLG = 1
WRITE(ITOUT,FMT=6660)
RETURN
ENDIF
ELSE
DMAX = DMAX * 2.0
GOTO 200
ENDIF
ENDIF
DO 300 I=1,15,1
DO 290 J=1,44,1
IF (BT(J) .EQ. LTYPE(I)(1:2)) THEN
LATTICE(J) = LATT_NAME(I)
SGLIST(J) = SPLIST(I)
ENDIF
290 ENDDO
300 ENDDO
C
C--- If we already have a cell and space group specified, we want to keep
C them so that we can use non-standard settings.
C Assign SCELL here (NOT KCELL, because if autoindexing fails, it will have
C a "junk" cell stored in array CELL.)
C
KICRYST = ICRYST
DO 310 I=1,6
SCELL(I) = CELL(I)
310 ENDDO
C
C--- But the MOSFLM OM is pre-multiplied by the wavelength, so we have to
C convert it, then we have to apply a pre-multiplying matrix to convert to
C the MOSFLM co-ordinate set before we can pass it to MOSFLM!
C
DO 350 I=1,44,1
DO 330 K=1,3,1
DO 320 J=1,3,1
A(J,K) = CL_OM(J,K,I)
AMATZ(J,K) = WAVE * A(J,K)
320 ENDDO
330 ENDDO
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
IF (NUMSPG.NE.0) THEN
IF (BT(I)(1:1) .EQ. 'a') ICRYST = 1
IF (BT(I)(1:1) .EQ. 'm') ICRYST = 2
IF (BT(I)(1:1) .EQ. 'o') ICRYST = 3
IF (BT(I)(1:1) .EQ. 't') ICRYST = 4
C
C--- no flag for trigonal (= hexagonal, metrically)!
C
IF (BT(I)(1:1) .EQ. 'h') ICRYST = 6
IF (BT(I)(1:1) .EQ. 'c') ICRYST = 7
IF (BT(I)(1:1) .EQ. 'r') ICRYST = 8
CALL PERMUTATE(CELL,AMAT,ICRYST,LATTYP)
END IF
DO 340 J=1,6,1
CELLB(J,I) = CELL(J)
340 ENDDO
350 ENDDO
C==============================================================================
C
C
C---- Trap failure if we've missed it before
C
IF (IERRFLG.EQ.1) RETURN
INEWMAT = 1
C
C---- If spacegroup unknown, give list of solutions sorted on merit
C
IF(PREREF)THEN
WRITE(IOUT,FMT=6700)
IF (ONLINE) WRITE(ITOUT,FMT=6700)
6700 FORMAT(1X,'List of possible Laue groups, sorted on penalty ',
+ 'index.',/,1X,'The lower the PENALTY, the better',
+ /,1X,'No PENALTY SDCELL FRACN LATT a b',
+ ' c alpha beta gamma ',
$ 'Possible spacegroups',/)
LINELEN = 150
ELSE
WRITE(IOUT,FMT=6705)
IF (ONLINE) WRITE(ITOUT,FMT=6705)
6705 FORMAT(1X,'List of possible Laue groups, sorted on penalty ',
+ 'index.',/,1X,'The lower the PENALTY, the better',
+ /,1X,'No PENALTY LATT a b c',
+ ' alpha beta gamma Possible spacegroups',/)
LINELEN = 130
ENDIF
C
IXW = 200
IYW = 200
NUMLIN = 40
C
C Create IO window with scrolling
C
IF (ONLINE.AND.WINOPEN) THEN
IF (BOXOPEN) CALL MXDCIO(1,0,0,0,0)
CALL MXDCIO(5,LINELEN, NUMLIN, IXW,IYW)
BOXOPEN = .TRUE.
IF(.NOT.USERCELL)THEN
LLINE = ' '
WRITE(LLINE,FMT=6710)
6710 FORMAT('List of possible Laue groups, sorted on ',
$ 'penalty index.')
CALL MXDWIO(LLINE, 2)
LLINE = ' '
WRITE (LLINE, 6720)
6720 FORMAT('The lower the PENALTY, the better')
CALL MXDWIO(LLINE, 2)
LLINE = ' '
WRITE (LLINE, 6730)
6730 FORMAT('Only solutions with PENALTY less than 200 are ',
+ 'listed, a complete list is given in the terminal',
$ ' window')
CALL MXDWIO(LLINE, 2)
LLINE = ' '
IF(PREREF)THEN
WRITE (LLINE, 6740)
6740 FORMAT(' No PENALTY SDCELL FRACN LATT a b',
+ ' c alpha beta gamma Possible ',
$ 'spacegroups')
CALL MXDWIO(LLINE, 2)
ELSE
WRITE (LLINE, 6745)
6745 FORMAT(' No PENALTY LATT a b c',
+ ' alpha beta gamma Possible spacegroups')
CALL MXDWIO(LLINE, 2)
ENDIF
ENDIF
ENDIF
C
C---- Sort Laue groups on figure of merit
C
CALL SORTUP2(NLAUEG,MERIT,IRESORDER)
C
C---- If the space group has been given, we want to be able to pick it out,
C so first get crystal system symmetry
C
BTSTR = ' '
IF(NUMSPG.GT.0)THEN
C
C---- triclinic ("anorthic")
C
IF (NUMSPG.LT.3)THEN
BTSTR(1:1) = 'a'
C
C---- monoclinic
C
ELSEIF (NUMSPG.LT.16)THEN
BTSTR(1:1) = 'm'
C
C---- orthorhombic
C
ELSEIF (NUMSPG.LT.75)THEN
BTSTR(1:1) = 'o'
C
C---- tetragonal
C
ELSEIF (NUMSPG.LT.143)THEN
BTSTR(1:1) = 't'
C
C---- trigonal or hexagonal
C
ELSEIF (NUMSPG.LT.195)THEN
BTSTR(1:1) = 'h'
C
C---- cubic
C
ELSEIF (NUMSPG.LE.230) THEN
BTSTR(1:1) = 'c'
ENDIF
C
C---- then get centreing
C
BTSTR(2:2) = SPGNAM(1:1)
IF(BTSTR(2:2).EQ.'H')BTSTR(2:2) = 'R'
ENDIF
C
C---- pick out the good solutions for background indexing
C
SNUMSPG = 0
IF((NSOL.EQ.-999).OR.usercell)THEN
LASTGOOD = 1
MAXGOOD = 0.0
DO 353 I=1,NLAUEG-1,1
c IF(MERIT(IRESORDER(I+1)).LE.200)THEN
TESTGOOD = (FLOAT(MERIT(IRESORDER(I+1)))
$ -FLOAT(MERIT(IRESORDER(I))))/
$ (FLOAT(MERIT(IRESORDER(I))+1))
IF(TESTGOOD.GT.MAXGOOD)THEN
MAXGOOD = TESTGOOD
LASTGOOD = I
ENDIF
c ENDIF
353 ENDDO
C
C---- now pick the solution with the highest symmetry
C
HIGHSYMM = 0
IF(BTSTR.EQ.' ')THEN
DO 356 I = 1,LASTGOOD
J = IRESORDER(I)
BTSTR = BT(J)
DO 355 K=1,14,1
IF (BTSTR.EQ.LTYPE(K))INDEX = K
355 ENDDO
IF(INDEX.GT.HIGHSYMM)THEN
HIGHSYMM = INDEX
LATTYP = LTYPE(index)(2:2)
BESTSOL = I
ENDIF
356 ENDDO
C
C---- triclinic
C
IF(LTYPE(HIGHSYMM).EQ.'aP')THEN
NUMSPG = 1
C
C---- monoclinic P
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'mP')THEN
NUMSPG = 3
C
C---- monoclinic C
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'mC')THEN
NUMSPG = 5
C
C---- orthorhombic P
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'oP')THEN
NUMSPG = 16
C
C---- orthorhombic C
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'oC')THEN
NUMSPG = 20
C
C---- orthorhombic F
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'oF')THEN
NUMSPG = 22
C
C---- orthorhombic I
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'oI')THEN
NUMSPG = 23
C
C---- tetragonal P
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'tP')THEN
NUMSPG = 75
C
C---- tetragonal I
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'tI')THEN
NUMSPG = 79
C
C---- trigonal or hexagonal P - if choosing automatically assume trigonal
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'hP')THEN
NUMSPG = 143
C
C---- trigonal or hexagonal R
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'hR')THEN
NUMSPG = 146
C
C---- primitive cubic
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'cP')THEN
NUMSPG = 195
C
C---- face-centred cubic
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'cF')THEN
NUMSPG = 196
C
C---- body-centred cubic
C
ELSEIF(LTYPE(HIGHSYMM).EQ.'cI')THEN
NUMSPG = 197
ENDIF
ELSE
C
C---- we only allow the current input cell to be chosen if option
C SOLU has _not_ been used on the AUTOINDEX line
C
IF(.NOT.LSOL.AND.(KCELL(1).GT.0).and.(KCELL(2).GT.0)
$ .and.(KCELL(3).GT.0).and.(KCELL(4).GT.0).and.
$ (KCELL(5).GT.0).and.(KCELL(6).GT.0))THEN
MAXGOOD = 999.0
DO 3550 I = 1,NLAUEG,1
J = IRESORDER(I)
IF(BTSTR.EQ.BT(J))THEN
C
C---- set up metric symmetry for PERMUTE
C
IF (BT(J)(1:1) .EQ. 'a') ICRYST = 1
IF (BT(J)(1:1) .EQ. 'm') ICRYST = 2
IF (BT(J)(1:1) .EQ. 'o') ICRYST = 3
IF (BT(J)(1:1) .EQ. 't') ICRYST = 4
IF (BT(J)(1:1) .EQ. 'h') ICRYST = 6
IF (BT(J)(1:1) .EQ. 'c') ICRYST = 7
IF (BT(J)(1:1) .EQ. 'r') ICRYST = 8
C
C---- only testing on cell edges at the moment...
C
TEST1 = KCELL(1)/CELLB(1,J)
IF(TEST1.LT.1.0)TEST1=1.0/TEST1
TEST2 = KCELL(2)/CELLB(2,J)
IF(TEST2.LT.1.0)TEST2=1.0/TEST2
TEST3 = KCELL(3)/CELLB(3,J)
IF(TEST3.LT.1.0)TEST3=1.0/TEST3
TESTGOOD = TEST1 * TEST2 * TEST3
IF(TESTGOOD.LT.MAXGOOD)THEN
MAXGOOD = TESTGOOD
BESTSOL = I
ENDIF
ELSE
ICRYST = 0
ENDIF
3550 ENDDO
IF(MAXGOOD.GT.1.2)THEN
WRITE(IOUT,FMT=977)
IF(ONLINE)WRITE(ITOUT,FMT=977)
ELSEIF(MAXGOOD.GT.1.1)THEN
WRITE(IOUT,FMT=978)
IF(ONLINE)WRITE(ITOUT,FMT=978)
ELSE
WRITE(IOUT,FMT=979)
IF(ONLINE)WRITE(ITOUT,FMT=979)
ENDIF
WRITE(IOUT,FMT=975)BTSTR,SCELL,
$ (CELLB(K,IRESORDER(BESTSOL)),K=1,6),BESTSOL,
$ MERIT(IRESORDER(BESTSOL))
IF(ONLINE)WRITE(ITOUT,FMT=975)BTSTR,SCELL,
$ (CELLB(K,IRESORDER(BESTSOL)),K=1,6),BESTSOL,
$ MERIT(IRESORDER(BESTSOL))
977 FORMAT('You have chosen a lousy solution. It doesn''t ',
$ 'fit the observed pattern very well.',/,
$ 'Your input ',
$ 'experimental parameters may be seriously in error')
978 FORMAT('The observed cell is not a close match to your ',
$ 'target cell. Check your experimental parameters ',
$ /,'carefully.')
979 FORMAT('This is the best match to your target cell: ')
975 FORMAT('Target cell: ',A2,1X,3(F8.3,1X),
$ 3(F6.2,1X),/,'Nearest found cell: ',
$ 3(F8.3,1X),3(F6.2,1X),'(Solution ',I2,', penalty ',
$ I3,')',
$ /,'see launch window or ',
$ 'mosflm.lp log file for full details',/)
ELSE
BESTSOL = 0
HIGHSYMM = 0
DO 357 I = 1,LASTGOOD
IF(.NOT.LSOL .AND. BESTSOL.EQ.0)THEN
J = IRESORDER(I)
IF(BTSTR.EQ.BT(J))BESTSOL = I
ENDIF
357 ENDDO
ENDIF
ENDIF
C
C
C---- need something here to watch out for no solution found by the program
C
c - if we have chosen a solution number? IF(BESTSOL.EQ.0.AND..NOT.LSOL)THEN
IF(BESTSOL.EQ.0)THEN
IF(WINOPEN)THEN
BESTSOL = 1
write(iout,359)
write(itout,359)
BADUSERCELL = .TRUE.
NUMSPG = 1
BTSTR = 'aP'
359 format(4('***** WARNING '),'*****',/,
$ ' Indexing with a known spacegroup has failed, so th',
$ 'e lowest symmetry solution',/,' has been chosen. Th',
$ 'is may be due to the beam position being incorrect,',
$ /,' or an error in another parameter',/,'The space ',
$ 'group has been set to P1 (#1)',/,4('***** WARNING '),
$ '*****',/)
ELSE
WRITE(IOUT,358)
IF(ONLINE)WRITE(ITOUT,358)
CALL SHUTDOWN
358 FORMAT(5('**** SEVERE ERROR '),'****',/,
$ 'Indexing has failed. You must examine your images ',
$ 'carefully and index interactively',
$ /,5('**** SEVERE ERROR '),'****')
ENDIF
ENDIF
SNUMSPG = NUMSPG
c NSOL = -BESTSOL
LSYMM = 1
ENDIF
C
C---- back to interactive stuff
C
STARTLIST = .TRUE.
NOCHOICE = .FALSE.
DO 395 WHILE (STARTLIST)
STARTLIST = .FALSE.
DO 390 I = NLAUEG,1,-1
J = IRESORDER(I)
BTSTR = BT(J)
DO 360 K = 1,15
IF (BTSTR.EQ.LTYPE(K)) THEN
INDEX = K
GOTO 370
END IF
360 ENDDO
C
370 CONTINUE
C
C---- NEW 13112000
C do the refinement for the current solution
C
IF(NSOL.LE.0.AND.PREREF)THEN
IF((MERIT(J).LE.200).OR.(SOLN.EQ.I))THEN
LATTYP = BTSTR(2:2)
C
C---- triclinic ("anorthic")
C
IF (BTSTR(1:1).EQ.'a')THEN
NUMSPG = 1
C
C---- monoclinic
C
ELSEIF (BTSTR(1:1).EQ.'m')THEN
NUMSPG = 3
C
C---- orthorhombic
C
ELSEIF (BTSTR(1:1).EQ.'o')THEN
NUMSPG = 16
C
C---- tetragonal
C
ELSEIF (BTSTR(1:1).EQ.'t')THEN
NUMSPG = 75
C
C---- trigonal or hexagonal - use P6
C
ELSEIF (BTSTR(1:1).EQ.'h')THEN
IF (BTSTR.EQ.'hR')THEN
NUMSPG = 146
ELSE
NUMSPG = 143
ENDIF
C
C---- cubic
C
ELSEIF (BTSTR(1:1).EQ.'c')THEN
NUMSPG = 196
ENDIF
C
C---- Skip if rhombohedral cell has been requested by CRYST keyword;
C we don't do this yet for DPS indexing
C
IF (ICRYST.EQ.8) GOTO 500
C
C
C---- Triclinic
C
IF (NUMSPG.LT.3) THEN
ICRYST = 1
ICS = 1
C
C---- Monoclinic
C
ELSE IF (NUMSPG.LT.16) THEN
ICRYST = 2
ICS = 3
C
C---- Orthorhombic
C
ELSE IF (NUMSPG.LT.75) THEN
ICRYST = 3
ICS = 4
C
C---- Tetragonal
C
ELSE IF (NUMSPG.LT.143) THEN
ICRYST = 4
ICS = 5
C
C---- Trigonal, but allow for rhombohedral settings (CRYST keyword)
C
ELSE IF (NUMSPG.LT.168) THEN
IF (ICRYST.NE.8) THEN
ICRYST = 5
ICS = 7
ENDIF
C
C---- Hexagonal
C
ELSE IF (NUMSPG.LT.195) THEN
ICRYST = 6
ICS = 7
C
C---- Cubic
C
ELSE IF (NUMSPG.LE.230) THEN
ICRYST = 7
ICS = 8
END IF
C
C---- Also set systematic absence flags and cell refinement flags
C
C
C---- Set cell refinement flags
C
500 CONTINUE
DO 510 II = 1,6
LCELL(II) = LCLASS(II,ICRYST)
510 ENDDO
C
C---- Get lattice type from spacegroup name
C
LATTYP = SPGNAM(1:1)
C
C
ISYS = 2
IF (LATTYP.EQ.'A') THEN
KSYS(1) = 0
KSYS(2) = 1
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'B') THEN
KSYS(1) = 1
KSYS(2) = 0
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'C') THEN
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 0
ELSE IF (LATTYP.EQ.'I') THEN
ISYS = 2
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'H') THEN
C
C---- Allow for choice of rhombohedral cell, but this is straight from TOREFIX;
C Harry doesn't let us do this. The 'ICRYST.EQ.8' bit should never
C be executed
C
IF (ICRYST.EQ.8) THEN
ISYS = 0
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
ELSE
ISYS = 3
KSYS(1) = -1
KSYS(2) = 1
KSYS(3) = 1
END IF
ELSE IF (LATTYP.EQ.'F') THEN
ISYS = 4
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
ELSE IF (LATTYP.EQ.'P') THEN
ISYS = 0
KSYS(1) = 1
KSYS(2) = 1
KSYS(3) = 1
END IF
C
C---- Now refine for the current solution
C
DO 520 II = 1,3
WAVMAT(II,II) = WAVE
520 ENDDO
DO 540 K=1,3,1
DO 530 II=1,3,1
A(II,K) = CL_OM(II,K,J)
530 ENDDO
540 ENDDO
CALL MATMUL3(AMAT,WAVMAT,A)
CALL MATCOP(AMAT,AMATZ)
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
NBAD(2) = 0
NBAD(3) = 0
C
C---- need to do this for outputting CELL
C
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
DO 545 III = 1,6
SDCELL(III) = 0.0
545 ENDDO
SDPHI = 0.5
SDXY = 1.0
ORGX = 0.0
ORGY = 0.0
DO 590 III = 1,4
NBAD(1) = 0
IF(III.GT.1)THEN
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
ENDIF
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
C
C================================================================
C--- calculate list of reflections from internal co-ordinates
C
C
C--- invert the A (=UB) matrix
C
CALL MINV33(AMATINV,AMAT,DA)
C
C--- remember that X(I), Y(I) and Z(I) were calculated according to DPS setting
C
CALL MATMUL3(AMATINVZ,AMATINV,DPS_TO_MOSFLM)
C
C--- Correct AMATINV for wavelength
C
CALL MATMUL3(AMATINV,AMATINVZ,WAVMAT)
MEANERR = 0.0
DO 560 II=1,COUNT
XYZ(1) = X(II)
XYZ(2) = Y(II)
XYZ(3) = Z(II)
C
C--- and convert to Miller indices
C
CALL MATVEC(FHKL,AMATINV,XYZ)
C
C--- Pick closest Miller index to this reciprocal space co-ordinate
C
IH(II) = NINT(FHKL(1))
IK(II) = NINT(FHKL(2))
IL(II) = NINT(FHKL(3))
REFLERR(II) = SQRT( (FHKL(1)-IH(II))**2
$ + (FHKL(2)-IK(II))**2 + (FHKL(3)-IL(II))**2 )
MEANERR = MEANERR + REFLERR(II)
C
C---
C
IPHI(II) = NINT(100*PHIMEAN(II))
560 ENDDO
MEANERR = MEANERR/COUNT
SUMSQDIFF = 0.0
DO 570 II=1,COUNT
SUMSQDIFF = SUMSQDIFF+(REFLERR(II)-MEANERR)**2
570 ENDDO
SUMSQDIFF = SDCUTOFF*(SQRT(SUMSQDIFF/COUNT))
DO 580 II = 1,COUNT
IF(ABS(MEANERR-REFLERR(II)).GT.SUMSQDIFF)THEN
IH(II) = 0
IK(II) = 0
IL(II) = 0
NBAD(1) = NBAD(1) + 1
ENDIF
580 ENDDO
C
C to refine the cell, orientation and distance properly, the next few bits of
C code are included.
C
NCYCLE = 6
IERR = 0
S0L(1) = LAMBDA_INV
C
C set parameters for refinement
C
IF (RFIXDIST)THEN
IC = 5
ELSE
IC = 4
ENDIF
C
C---- save original cell edges for the chosen symmetry
C
IF(.NOT.LSOL.AND.(KCELL(1).GT.0).and.
$ (KCELL(2).GT.0).and.(KCELL(3).GT.0))THEN
CELLS(1) = KCELL(1)
CELLS(2) = KCELL(2)
CELLS(3) = KCELL(3)
ELSE
CELLS(1) = CELL(1)
CELLS(2) = CELL(2)
CELLS(3) = CELL(3)
ENDIF
C
C--- use reciprocal cell with A-1 units, not dimensionless
C
CALL RECCEL(RCELL,CELL,1.0)
C
C--- need BMAT according to REFIX orthogonalization
C
CALL RFBMAT(BMAT,RCELL,WAVE)
CALL MINV33(BMATINV,BMAT,DA)
CALL MATMUL3(UMAT,AMAT,BMATINV)
NREF = COUNT
IF(DEBUG(70))THEN
IF(ONLINE)WRITE(ITOUT,*)'CELREF in '
IF(ONLINE)WRITE(ITOUT,6520)NCYCLE,REIDX0,NREF,
$ ACHSE,IC,ICS,RAST,ORGX,ORGY,XTD,S0L,
1 ((ED(ICO,JCO),JCO=1,3),ICO=1,3),
$ ((UMAT(ICO,JCO),JCO=1,3),
2 ICO=1,3),RCELL,CELL,
+ SDU,SDCELL,SDPHI,SDXY,SDCUTOFF,IERR
WRITE(IOUT,*)'CELREF out '
WRITE(IOUT,6520)NCYCLE,REIDX0,NREF,ACHSE,IC,ICS,
$ RAST,ORGX,ORGY,XTD,S0L,
1 ((ED(ICO,JCO),JCO=1,3),ICO=1,3),
+ ((UMAT(ICO,JCO),JCO=1,3),ICO=1,3),RCELL,CELL,
$ SDU,SDCELL,SDPHI,SDXY,SDCUTOFF,IERR
ENDIF
CALL CELREF(NCYCLE,REIDX0,NREF,IH,IK,IL,IXD,IYD,IPHI,
$ ACHSE,IC,ICS,RAST,
$ ORGX,ORGY,XTD,S0L,ED,UMAT,RCELL,SDU,SDCELL,SDPHI,
+ SDXY,SDCUTOFF,NBAD,IERR)
IF(DEBUG(70))THEN
CALL RECCEL(CELL,RCELL,1.0)
IF(ONLINE)WRITE(ITOUT,*)'CELREF out '
IF(ONLINE)WRITE(ITOUT,6520)NCYCLE,REIDX0,NREF,
$ ACHSE,IC,ICS,RAST,ORGX,ORGY,XTD,S0L,
1 ((ED(ICO,JCO),JCO=1,3),ICO=1,3),
+ ((UMAT(ICO,JCO),JCO=1,3),ICO=1,3),RCELL,CELL,
$ SDU,SDCELL,SDPHI,SDXY,SDCUTOFF,IERR
WRITE(IOUT,*)'CELREF out '
WRITE(IOUT,6520)NCYCLE,REIDX0,NREF,ACHSE,IC,ICS,
$ RAST,ORGX,ORGY,XTD,S0L,
1 ((ED(ICO,JCO),JCO=1,3),ICO=1,3),
$ ((UMAT(ICO,JCO),JCO=1,3),ICO=1,3),RCELL,CELL,
+ SDU,SDCELL,SDPHI,SDXY,SDCUTOFF,IERR
ENDIF
C
C--- Check to make sure the number of reflections used was reasonable
C
IF((IERR .EQ. 0) .OR. (NBAD(1) .EQ. NREF))THEN
C
C--- We MUST jump out of the loop if IERR = 0!!
C
GOTO 595
ENDIF
IF (.NOT. RFIXDIST)XTOFD = 100.0*XTD*COS2TH
C
C--- next bits to extract MOSFLM AMAT from REFIX UMAT and RCELL...
C (SETMAT doesn't work as orthogonalization of BMAT in CELREF is _not_ the
C same as in MOSFLM)
CALL RFBMAT(BMAT,RCELL,WAVE)
CALL MATMUL3(AMAT,UMAT,BMAT)
CALL RECCEL(CELL,RCELL,1.0)
590 ENDDO
IF ((NBAD(1).GE.4*NREF/5).AND.(NBAD(2).EQ.0))THEN
NBAD(2) = NBAD(2) + 1
ELSE
IF ((NBAD(1).GE.NREF/2).AND.(NBAD(2).EQ.0)
$ .AND.(NBAD(3).EQ.0))THEN
NBAD(3) = NBAD(3) + 1
ENDIF
ENDIF
595 IF(IERR.EQ.0)THEN
CALL MATMUL3(AMATZ,WAVMAT,A)
CALL MATMUL3(AMAT,DPS_TO_MOSFLM,AMATZ)
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL CELLFIX(CELL)
IMAT = 0
IUMAT = 1
ICELL = 1
ICHECK = 11
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
INDNOREF = .TRUE.
ENDIF
C
C---- where do we get indnoref from?
C
IF(.NOT.INDNOREF)THEN
LLINE = ' '
C
C---- if the cell edges have changed dramatically in the refinement, the
C user should be warned and the update should not be the default!
C
DO 585 II=1,3,1
CELLCH(II) = CELLS(II)/CELL(II)
IF (CELLCH(II) .LT. 1)CELLCH(II) = 1.0/CELLCH(II)
IF (CELLCH(II).GT.1.05)THEN
STR1 = char(64 + II)
MISMATCH = (CELLCH(II) - 1.0)*100
LLINE = ' '
ENDIF
585 ENDDO
ENDIF
ICELL = 0
C
C--- rough calculation of minimum spot separation on image
C
IF(RCELL(1).LT.RCELL(2))THEN
MINSPLIT=RCELL(1)
ELSE
IF (RCELL(2).LT.RCELL(3))THEN
MINSPLIT = RCELL(2)
ELSE
MINSPLIT = RCELL(3)
ENDIF
ENDIF
MINSPLIT = WAVE*XTD*MINSPLIT
C
C--- Check shift in beam position and output it with a warning if it's big
C
XTEMP = (ORGX*RAST/COS2TH)
YTEMP = ORGY*RAST*(XTD-(XTEMP*SIN2TH))/XTD
XCOR = XTEMP*FR_MAT(1,1) + YTEMP*FR_MAT(2,1)
YCOR = XTEMP*FR_MAT(1,2) + YTEMP*FR_MAT(2,2)
XTEMP = SQRT(XCOR**2+YCOR**2)
YTEMP = XTEMP/MINSPLIT
MATNUM = 12
LDUM = 80
IFAIL = 1
C
C---- these aren't really sdxy and sdphi!
C
SDXY = SDXY*RAST
SDPHI = FLOAT(IERR)/FLOAT(NREF)
ELSE
SDXY = 999.9
SDPHI = 999.9
ENDIF
C
C---- 13112000 return to old code....
C
ENDIF
C---- Write out the results, first if we have refined the solutions
C
IF(PREREF)THEN
IF((MERIT(J).LE.200).OR.(SOLN.EQ.I))THEN
WRITE(IOUT,FMT=6750) I,MERIT(J),SDXY,SDPHI,BT(J),
+ (CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
IF (ONLINE) WRITE(ITOUT,FMT=6750)I,MERIT(J),SDXY,SDPHI,
+ BT(J),(CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
IF (ONLINE.AND.WINOPEN) WRITE(LLINE,FMT=6760)I,
+ MERIT(J),SDXY,SDPHI,BT(J),(CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
6750 FORMAT(1X,I3,1X,I4,5X,F5.3,1X,F4.2,2X,A,3F9.2,2X,3F6.1,
$ 3X,A)
6760 FORMAT(I3,1X,I4,5X,F5.3,1X,F4.2,3X,A,3F9.2,2X,3F6.1,
$ 3X,A)
IF (ONLINE.AND.WINOPEN)
$ CALL MXDWIO(LLINE, 2)
IF (INDEX.EQ.11) THEN
WRITE(IOUT,FMT=6770) SPLISTB(1:LENSTR(SPLISTB))
IF (ONLINE) WRITE(ITOUT,FMT=6770)
$ SPLISTB(1:LENSTR(SPLISTB))
IF (ONLINE.AND.WINOPEN) WRITE(LLINE,FMT=6770)
$ SPLISTB(1:LENSTR(SPLISTB))
6770 FORMAT(78X,A)
IF (ONLINE.AND.((MERIT(J).LE.200).OR.(SOLN.EQ.I))
$ .AND.WINOPEN)CALL MXDWIO(LLINE, 2)
END IF
ELSE
C
C---- MERIT(J).GT.200 or not a high penalty solution chosen, so not
C written to window
C
WRITE(IOUT,FMT=6752) I,MERIT(J),BT(J),
+ (CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
IF (ONLINE) WRITE(ITOUT,FMT=6752)I,MERIT(J),
+ BT(J),(CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
6752 FORMAT(1X,I3,1X,I4,5X,' unrefined',2X,A,3F9.2,2X,3F6.1,
$ 3X,A)
IF (INDEX.EQ.11) THEN
WRITE(IOUT,FMT=6772) SPLISTB(1:LENSTR(SPLISTB))
IF (ONLINE) WRITE(ITOUT,FMT=6772)
$ SPLISTB(1:LENSTR(SPLISTB))
6772 FORMAT(78X,A)
ENDIF
ENDIF
C
C---- write out the solutions if we haven't refined them
C
ELSE
WRITE(IOUT,FMT=6755) I,MERIT(J),BT(J),(CELLB(K,J),K=1,6),
+ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
IF (ONLINE) WRITE(ITOUT,FMT=6755) I,MERIT(J),BT(J),
+ (CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
IF(USERCELL)THEN
IF(ONLINE.AND.WINOPEN.AND.(I.EQ.BESTSOL))THEN
C
C---- new window with scrolling
C
IXW = 200
IYW = 200
NUMLIN = 20
LINELEN = 100
IF (BOXOPEN) CALL MXDCIO(1,0,0,0,0)
CALL MXDCIO(5,LINELEN, NUMLIN, IXW,IYW)
BOXOPEN = .TRUE.
IF(BADUSERCELL)THEN
write(ioline,fmt=359)
call windio(nuline)
ENDIF
WRITE(IOLINE,FMT=975)BT(J),SCELL,
$ (CELLB(K,IRESORDER(BESTSOL)),K=1,6),BESTSOL,
$ MERIT(IRESORDER(BESTSOL))
CALL WINDIO(NULINE)
LLINE = ' '
6890 FORMAT('Do you want to accept this result? (Y): ')
WRITE(LLINE,6890)
CALL MXDWIO(LLINE,1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF (STR1.NE.'Y')THEN
6895 FORMAT('Do you want to pick a result from the ',
$ 'complete list? (Y): ')
WRITE(LLINE,6895)
CALL MXDWIO(LLINE,1)
CALL MXDRIO(LINE2)
CALL MPARSE(LINE2,IBEG,IEND,ITYP,VALUE,IDEC,NTOK)
IF (NTOK.EQ.0) THEN
STR1 = 'Y'
ELSE
STR1 = LINE2(IBEG(1):IEND(1))
CALL CCPUPC(STR1)
END IF
IF(STR1.EQ.'Y')THEN
C NSOL = 0
BESTSOL = 0
C NUMSPG = 0
C SNUMSPG = 0
C SPGNAM = ' '
STARTLIST = .TRUE.
CALL MXDCIO(1,0,0,0,0)
NUMLIN = 40
LINELEN = 130
CALL MXDCIO(5,LINELEN, NUMLIN, IXW,IYW)
BOXOPEN = .TRUE.
LLINE = ' '
WRITE (LLINE, 6745)
CALL MXDWIO(LLINE, 2)
ELSE
NOCHOICE = .TRUE.
ENDIF
ENDIF
ENDIF
ELSE
IF (ONLINE.AND.((MERIT(J).LE.200).or.(soln.eq.j))
$ .AND.WINOPEN)THEN
WRITE(LLINE,FMT=6765) I,MERIT(J),
+ BT(J),(CELLB(K,J),K=1,6),
$ SPLIST(INDEX)(1:LENSTR(SPLIST(INDEX)))
CALL MXDWIO(LLINE, 2)
ENDIF
ENDIF
6755 FORMAT(1X,I3,I4,4X,A,3F9.2,2X,3F6.1,3X,A)
6765 FORMAT(I3,I4,5X,A,3F9.2,2X,3F6.1,3X,A)
IF (INDEX.EQ.11) THEN
WRITE(IOUT,FMT=6775) SPLISTB(1:LENSTR(SPLISTB))
IF (ONLINE) WRITE(ITOUT,FMT=6775)
$ SPLISTB(1:LENSTR(SPLISTB))
IF(USERCELL)THEN
ELSE
IF (ONLINE.AND.((MERIT(J).LE.200).or.(soln.eq.j))
$ .AND.WINOPEN)THEN
WRITE(LLINE,FMT=6775)
$ SPLISTB(1:LENSTR(SPLISTB))
CALL MXDWIO(LLINE, 2)
6775 FORMAT(64X,A)
ENDIF
ENDIF
ENDIF
ENDIF
390 ENDDO
IF(STARTLIST)USERCELL = .FALSE.
395 ENDDO
IF(NOCHOICE)THEN
IERRFLG = 1
CALL MXDCIO(1,0,0,0,0)
BOXOPEN = .FALSE.
6790 FORMAT(/,'***** No solution has been chosen from autoindexing',
$ ' - Space group and *****',/,' cell parameters have',
$ ' been reset to starting values ')
WRITE(IOUT,6790)
IF(ONLINE)WRITE(ITOUT,6790)
NUMSPG = SAVNUMSPG
SPGNAM = SAVSPGNAM
ICRYST = SAVICRYST
DO 410 I=1,3
DO 405 J=1,3
AMAT(I,J) = SAVAMAT(I,J)
405 ENDDO
410 ENDDO
IMAT = 1
IUMAT = 0
ICELL = 0
ICHECK = 0
CALL SETMAT(IMAT,IUMAT,ICELL,ICHECK)
CALL XDLF_FLUSH_EVENTS(I)
RETURN
ENDIF
C
C---- Now restore chosen space group from before the refinement
C
IF(SNUMSPG.NE.0)NUMSPG = SNUMSPG
NSOL = BESTSOL
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
C
WRITE(IOUT,FMT=6780)
IF (ONLINE) THEN
IF(PREREF)THEN
WRITE(ITOUT,FMT=6780)
6780 FORMAT(1X,'No PENALTY SDCELL FRACN LATT a b',
$ ' c',
+ ' alpha beta gamma Possible spacegroups',/)
ELSE
WRITE(ITOUT,FMT=6785)
6785 FORMAT(1X,'No PENALTY LATT a b c',
+ ' alpha beta gamma Possible spacegroups',/)
ENDIF
ENDIF
C
RETURN
END
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C end of to_dps_index.f
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C== TOPHAT ==
C
C
C
SUBROUTINE TOPHAT(OD,LRAS,MASK)
C ===============================
C
C
C
C---- Set up a top hat profile for those boxes whose profile has
C been rejected after the second averaging pass.
C all peak points are set to 1000, all backgrouns points to zero.
C
C
C
C
C .. Array Arguments ..
INTEGER LRAS(5),MASK(*),OD(*)
C ..
C .. Local Scalars ..
INTEGER HX,HY,IJ,P,Q
C ..
C
C
HX = LRAS(1)/2
HY = LRAS(2)/2
C
C
IJ = 0
C
C
DO 20 P = -HX,HX
DO 10 Q = -HY,HY
IJ = IJ + 1
C
C
IF (MASK(IJ).LE.0) THEN
OD(IJ) = 0
ELSE
OD(IJ) = 1000
END IF
10 CONTINUE
20 CONTINUE
C
C
END
C== TRANSP ==
C
C
C
SUBROUTINE TRANSP(A,B)
C =====================
C
C---- Transpose a 3x3 matrix
C
C A = BT
C
C
C
C .. Array Arguments ..
REAL A(3,3),B(3,3),C(3,3)
C ..
C .. Local Scalars ..
INTEGER I,J
C ..
C
C
DO 20 I = 1,3
DO 10 J = 1,3
A(I,J) = B(J,I)
10 CONTINUE
20 CONTINUE
C
C
END
C== UNIQUE ==
SUBROUTINE UNIQUE(IHKLSTR)
C
IMPLICIT NONE
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C PROGRAM UNIQUE
C
C Calculates how many unique reflections occur within
C given resolution limits.
C A.G.W. Leslie Nov 1984
C OUTPUT:
C
C For each reflection: ADATA(6)
C 1-3 h,k,l
C 4 -999 (Identifier)
C 5 ICENT =0 centric
C =1 acentric
C 6 zero (not used)
C ..
C .. Array Arguments ..
INTEGER*2 IHKLSTR(MCOLSTR,NREFSTR)
C ..
C .. Local Scalars ..
REAL EPS,SINTHL,THETA,DSTSQ,S,DTR,DSTMAXSQ,DSTMINSQ
INTEGER HMAX,HMIN,I,ICENT,IH,IK,IL,IPRINT,ISYSAB,J,KMAX,KMIN,
+ LMAX,LMIN,NIN,NREJS,ICOL,JDUMP
C ..
C .. Local Arrays ..
REAL ADATA(MCOLSTR)
INTEGER IHKL(3)
C ..
C .. External Functions ..
INTEGER INASU
EXTERNAL INASU
C ..
C .. External Subroutines ..
EXTERNAL ASUSET,CENTR,EPSLON,HKLLIM,LWREFL
C ..
C .. Intrinsic Functions ..
INTRINSIC REAL
C ..
C .. Common blocks ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/cell.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file cell.h
C---- START of include file cell.h
C
C CELL cell dimensions (real space)
C RCELL reciprocal cell parameters in dimensionless rlu
C
C .. Arrays in Common /CELLCOM/ ..
REAL UMAT,BMAT,GMAT,CELL,RCELL,UMATCELL
INTEGER LCELL,ICRYST,NUMSPG,NLAUE
C ..
C .. Common Block /CELLCOM/ ..
COMMON /CELLCOM/UMAT(3,3),BMAT(3,3),GMAT(3,3),CELL(6),RCELL(6),
$ UMATCELL(6),LCELL(6),ICRYST,NUMSPG,NLAUE
C ..
C
C
C&&*&& end_include ../inc/cell.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C .. Save statement ..
SAVE
C ..
C .. Data statements ..
C ..
C
C
MTZOUT = 1
NIN = 0
NUNIQ = 0
DTR = ATAN(1.0)/45.0
DSTMAXSQ = (DSTMAX/WAVE)**2
DSTMINSQ = (DSTMIN/WAVE)**2
CAL WRITE(6,*),'DSTMIN',1.0/DSTMIN
C
C ************************************************
C
C---- Set column 4 (F) or 5 (BATCH) to -999 to allow UNIQUE
C reflections to be distinguished from measured reflections
C or those produced by OSCGEN, and to ensure that when UNIQUE
C MTZ file is merged with any other MTZ file, after sorting
C on the first five columns the UNIQUE reflection record
C always comes before the true data record for any h,k,l
C
C
DO 10 I = 1,MCOLSTR
ADATA(I) = 0.0
10 CONTINUE
C
C
ADATA(4) = -999.0
C
C
C
C---- Calculate limits on H,K,L
C
C
C ******************************************
CALL HKLLIM(HMIN,HMAX,KMIN,KMAX,LMIN,LMAX)
C ******************************************
C
WRITE (IOUT,FMT=6002) HMIN,HMAX,KMIN,KMAX,LMIN,LMAX
IF (ONLINE) WRITE (ITOUT,FMT=6002) HMIN,HMAX,KMIN,KMAX,LMIN,LMAX
6002 FORMAT (/,1X,'Now generating the list of unique reflections',/,
+ 1X,'Limits on h,k,l..',3 (I4,' to',I4,3X))
IF (SHRUNK) THEN
WRITE(IOUT,FMT=6003) CELLSCAL
IF (ONLINE) WRITE(ITOUT,FMT=6003) CELLSCAL
6003 FORMAT(1X,'*** Note that all cell parameters have been ',
+ 'divided by',F7.4,' to speed up the calculation',/,
+ 1X,'This will affect the maximum indices and number of',
+ ' unique reflections')
END IF
C
C---- Loop over reflection limits
C
NREJS = 0
C
C
DO 70 IH = HMIN,HMAX
DO 60 IK = KMIN,KMAX
DO 50 IL = LMIN,LMAX
NIN = NIN + 1
C
C---- Test for limiting conditions for indices
C
IHKL(1) = IH
IHKL(2) = IK
IHKL(3) = IL
C
C
IF (IH.EQ.0 .AND. IK.EQ.0 .AND. IL.EQ.0) GO TO 50
C
C INASU returns +1 if reflection is in bounds
C *********************
IF (INASU(IHKL, NLAUE) .LE. 0) GO TO 50
C *********************
C
C
C---- EPS = multiplicity of this reflection.
C ISYSAB = 1 - systematic absence
C
ISYSAB = 0
C
C ***********************
CALL EPSLON(IHKL,EPS,ISYSAB)
C ***********************
C
C---- Test for systematic absences
IF (ISYSAB .EQ. 1) GO TO 50
C
C---- Calculate resolution
C
C
C---- Calculate dstarsq in dimensionless rlu
C
DSTSQ = IH*IH*RCELL(1)*RCELL(1) +IK*IK*RCELL(2)*RCELL(2)
+ +IL*IL*RCELL(3)*RCELL(3) +
+ 2.0*IH*IK*RCELL(1)*RCELL(2)*COS(RCELL(6)*DTR) +
+ 2.0*IK*IL*RCELL(2)*RCELL(3)*COS(RCELL(4)*DTR) +
+ 2.0*IH*IL*RCELL(1)*RCELL(3)*COS(RCELL(5)*DTR)
C
S = DSTSQ/(WAVE**2)
IF ((S.LT.DSTMINSQ) .OR. (S.GT.DSTMAXSQ)) THEN
NREJS = NREJS + 1
GO TO 40
END IF
C
C
ADATA(1) = REAL(IHKL(1))
ADATA(2) = REAL(IHKL(2))
ADATA(3) = REAL(IHKL(3))
C
C
ADATA(5) = 1.0
C
C *****************
CALL CENTR(IHKL,ICENT)
C *****************
C ICENT returned as 1 if centric, 0 if acentric
C
IF (ICENT.EQ.1) ADATA(5) = 0.0
C
C ********************
CAL CALL LWREFL(MTZOUT,ADATA)
C ********************
C
NUNIQ = NUNIQ + 1
IF ((NUNIQ+NSTRAT).GT.NREFSTR) THEN
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
STOP
END IF
6000 FORMAT(//,1X,'***** FATAL ERROR *****',/,1X,
+ 'Not enough memory to store all generated reflections',/,1X,
+ 'Either reduce the rotation range or increase parameter ',
+ 'IXWDTH or IYLENGTH',/,1X,'and recompile program')
C
C---- Store unique reflections after the generated ones
C
DO 30 ICOL = 1,MCOLSTR
IHKLSTR(ICOL,NSTRAT+NUNIQ) = NINT(ADATA(ICOL))
30 CONTINUE
IF (DEBUG(55).AND.(JDUMP.LT.NDEBUG(55))) THEN
JDUMP = JDUMP + 1
WRITE(IOUT,FMT=6010) IH,IK,IL
IF (ONLINE) WRITE(ITOUT,FMT=6010) IH,IK,IL
6010 FORMAT(1X,'Indices',3I5)
END IF
40 CONTINUE
C
50 CONTINUE
60 CONTINUE
70 CONTINUE
C
C
WRITE (IOUT,FMT=6004) NIN,NUNIQ
IF (ONLINE) WRITE (ITOUT,FMT=6004) NIN,NUNIQ
6004 FORMAT (1X,I6,' reflections tested',/1X,I6,
$ ' reflections found within resolution limits ')
C
END
C
C== UNIT ==
SUBROUTINE UNIT(V)
C =================
C
C
REAL V(3)
C****VECTOR V REDUCED TO UNIT VECTOR
VMOD=V(1)**2+V(2)**2+V(3)**2
IF (VMOD.LE.0.0) RETURN
VMOD=SQRT(VMOD)
DO 1 I=1,3
1 V(I)=V(I)/VMOD
RETURN
END
C
C
C== V2CROSS ==
SUBROUTINE V2CROSS(A,B,AR)
C ..
C .. Scalar Arguments ..
REAL AR
C ..
C .. Array Arguments ..
REAL A(2),B(2)
AR = A(1)*B(2) - B(1)*A(2)
AR = ABS(AR)
END
C
C
C== V2SUB ==
SUBROUTINE V2SUB(A,B,C)
C ..
C .. Array Arguments ..
REAL A(2),B(2),C(2)
C
C .. Local Scalars ..
INTEGER I
C
C---- C = A - B
C
DO 10 I = 1,2
C(I) = A(I) - B(I)
10 CONTINUE
END
SUBROUTINE VADD(V1,V2,V3)
C ====
C
C V1 = V2 + V3
C
IMPLICIT NONE
REAL V1(3), V2(3), V3(3)
INTEGER I
C
DO 100 I = 1, 3
V1(I) = V2(I) + V3(I)
100 CONTINUE
C
RETURN
C
END
SUBROUTINE VADDG(V3, V1, V2, N)
C ====
C
C Subroutine to add two vectors V1 and V2 to V3.
C Dimension of vectors is N.
C
INTEGER N
REAL V1(N), V2(N), V3(N)
C
DO 100 I = 1, N
V3(I) = V1(I) + V2(I)
100 CONTINUE
C
RETURN
C
END
C== VARPROF ==
SUBROUTINE VARPROF(MODE,XCGBOX,YCGBOX,XCGCEN,YCGCEN,ICENBOX,
+ CENTRAL,XR,YR,NSBOX,IPRNUM,WTPR)
C
IMPLICIT NONE
C---- Given the coordinates and box numbers of the standard profiles,
C sets up the "virtual" profiles (a box number and coordinates only)
C for boxes surrounding the real profiles ie around the periphery of
C the image.
C In general, any given standard profile will be surrounded by eight
C other profiles. If we imagine these profiles to be the true profile
C at some point (eg the centroid) of the areas over which each profile
C formed, then these 8 points define four quadrilaterals, which have the
C position of the original standard profile as a common vertex.
C For each real profile box, determine the four possible sets of
C 4 profiles that are required to calculate an average profile. For
C each set, the coordinates of the standard (or virtual) profiles
C define a quadrilateral, thus each real profile will have four
C quadrilaterals associated with it, and each quadrilateral will
C have four vertices. These are stored in IQUAD. The area of each
C quadrilateral is also calculated as this is required by the
C algorithm that determines which of the four quadrilaterals a
C particular spot with coordinates XR,YR actually lies in. The
C profiles at the vertices of the quadrilateral containing the
C spot are used to calculate the weighted profile, using linear
C interpolation. The actual weights to be assigned to the four
C profiles are determined by subroutine PRWEIGHT
C
C---- MODE = 0 Initialisation, sets up AQUAD, IQUAD
C
C .NE.0. Calculate profiles and weights for spot with (pixel)
C coordinates XR,YR
C
C DEBUG(35) this S/R
C ..
C .. Parameters
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE,NSBOX,ICENBOX
REAL XR,YR,XCGCEN,YCGCEN
LOGICAL CENTRAL
C ..
C .. Array Arguments ..
INTEGER IPRNUM(9)
REAL XCGBOX(NMASKS),YCGBOX(NMASKS),WTPR(9)
C
C .. Local Scalars ..
INTEGER I,J,K,L,IJBOX,IVBOX,NRVBOX,IS,JS,IQ,IQOPT,IV,IP,NY,
+ I1,I2,J1,J2,ND,NECX,NECY,NXMID,NYMID,NVRBOX,NVBOX
REAL XBOX,YBOX,ARMIN,ARDEL,DELXC,DELYC,ATEMP
LOGICAL GOODBOX
C ..
C .. Local Arrays ..
INTEGER IQUAD(NMASKS,4,4),ISP(4),JSP(4)
REAL XCBOX(-2*NMASKS:NMASKS),YCBOX(-2*NMASKS:NMASKS),
+ AQUAD(NMASKS,4),XYQ(2,4),XYR(2),XCV(4),YCV(4)
C ..
C .. External Functions ..
REAL AREAQ,AREA
EXTERNAL AREAQ,AREA
C ..
C .. External Subroutines ..
EXTERNAL PRWEIGHT,GETYIND,GETSTRIP
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C
C ..
SAVE
C
C .. Data statements ..
DATA ISP/1,-1,-1,1/,JSP/1,1,-1,-1/
DATA ND/0/
C
C---- Initialise weights to zero
C
DO 1 I = 1,9
IPRNUM(I) = 0
WTPR(I) = 0.
1 CONTINUE
C
NECX = FACT*XCEN + 0.5
NECY = FACT*YCEN + 0.5
NXMID = NXLINE/2
NYMID = NYLINE/2
IF (MODE.GT.0) GOTO 90
C
C---- Initialise AQUAD, IQUAD
C
DO 8 I = 1,NMASKS
DO 6 J = 1,4
AQUAD(I,J) = 0.0
DO 4 K = 1,4
IQUAD(I,J,K) = 0
4 CONTINUE
6 CONTINUE
8 CONTINUE
DO 9 I = -2*NMASKS,NMASKS
XCBOX(I) = 0.0
YCBOX(I) = 0.0
9 CONTINUE
C
C---- First test that all real boxes have a non-zero centre coords. If a box
C has no acceptable reflections in it, the box coords will be zero !
C
DO 2 I = 1,NUMBOX
IF (.NOT.BOX(I)) GOTO 2
IF ((XCGBOX(I).EQ.0.0).AND.(YCGBOX(I).EQ.0.0)) THEN
C
C---- Set coords to middle of box
C
CALL GETSTRIP(I,IP)
CALL GETYIND(I,NY)
XCGBOX(I) = 0.5*(XLINE(IP)+XLINE(IP+1))*FACT
YCGBOX(I) = 0.5*(YLINE(NY)+YLINE(NY+1))*FACT
IF (DEBUG(35)) THEN
WRITE(IOUT,FMT=6012) I,IP,NY,XCGBOX(I),YCGBOX(I)
IF (ONLINE) WRITE(ITOUT,FMT=6012) I,IP,NY,XCGBOX(I),
+ YCGBOX(I)
6012 FORMAT(1X,'VARPROF C of G set up for box',I3,' in strip',
+ I3,' Y index',I3,' as',2F10.2)
END IF
END IF
2 CONTINUE
NVRBOX = 0
DO 10 I = 0,NNLINE
C
C---- Set the X coordinate to that of the real box (if any) in the same
C column (vertical), otherwise set to first or last stripe
C
IJBOX = IBOX(I,NYMID)
IF (IJBOX.GT.0) THEN
GOODBOX = BOX(IJBOX)
ELSE
GOODBOX = .FALSE.
END IF
IF (GOODBOX) THEN
XBOX = XCGBOX(IJBOX)
ELSE
IF (I.LT.NXMID) THEN
XBOX = 0.0
ELSE
XBOX = FLOAT(NREC)
END IF
END IF
C
DO 20 J = 0,NNLINE
C
C---- See if this is a virtual box
C
IJBOX = IBOX(I,J)
IF (IJBOX.GT.0) THEN
GOODBOX = BOX(IJBOX)
ELSE
GOODBOX = .FALSE.
END IF
IF (GOODBOX) THEN
XCBOX(IJBOX) = XCGBOX(IJBOX)
YCBOX(IJBOX) = YCGBOX(IJBOX)
GOTO 20
ELSE
C
C---- This is a virtual box
C
NVRBOX = NVRBOX + 1
IBOX(I,J) = -NVRBOX
XCBOX(-NVRBOX) = XBOX
C
C---- Set the Y coordinate to that of the real box (if any) in the same
C row (horizontal), otherwise set to first or last pixel in stripe
C
IJBOX = IBOX(NXMID,J)
IF (IJBOX.GT.0) THEN
GOODBOX = BOX(IJBOX)
ELSE
GOODBOX = .FALSE.
END IF
IF (GOODBOX) THEN
YBOX = YCGBOX(IJBOX)
ELSE
IF (J.LT.NYMID) THEN
YBOX = 0.0
ELSE
YBOX = FLOAT(IYLEN)
END IF
END IF
C
YCBOX(-NVRBOX) = YBOX
END IF
C
20 CONTINUE
10 CONTINUE
C
C
IF (DEBUG(35)) THEN
DO 12 J = 1,NNLINE-1
WRITE(IOUT,FMT=6000)
WRITE(IOUT,FMT=6002) (IBOX(I,J),I=0,NNLINE)
WRITE(IOUT,FMT=6004) (XCBOX(IBOX(I,J)),YCBOX(IBOX(I,J)),
+ I=0,NNLINE)
IF (ONLINE) THEN
WRITE(ITOUT,FMT=6000)
WRITE(ITOUT,FMT=6002) (IBOX(I,J),I=0,NNLINE)
WRITE(ITOUT,FMT=6004) (XCBOX(IBOX(I,J)),YCBOX(IBOX(I,J)),
+ I=0,NNLINE)
END IF
12 CONTINUE
END IF
6000 FORMAT(//1X,'IBOX and C. of G. coordinates')
6002 FORMAT(1X,10I12)
6004 FORMAT(1X,20F6.0)
C
C---- All possible boxes have been assigned numbers and coordinates.
C For all real boxes, determine the four possible quadrilaterals
C which could be required for the weighted profile, each corner
C of these quadrilaterals being defined by a box number
C Thus IQUAD(box number, quad. number, vertex number) = box number for
C this vertex
DO 30 I = 1,NNLINE-1
DO 40 J = 1,NNLINE-1
IJBOX = IBOX(I,J)
IF (IJBOX.LT.0) GOTO 40
C
C---- This is a real box
C
DO 50 IQ = 1,4
IS = ISP(IQ)
JS = JSP(IQ)
IF (IS.LT.0) THEN
I1 = I + IS
I2 = I
ELSE
I2 = I + IS
I1 = I
END IF
IF (JS.LT.0) THEN
J1 = J + JS
J2 = J
ELSE
J2 = J + JS
J1 = J
END IF
C
IQUAD(IJBOX,IQ,1) = IBOX(I1,J1)
IQUAD(IJBOX,IQ,2) = IBOX(I1,J2)
IQUAD(IJBOX,IQ,3) = IBOX(I2,J2)
IQUAD(IJBOX,IQ,4) = IBOX(I2,J1)
DO 60 IV = 1,4
IVBOX = IQUAD(IJBOX,IQ,IV)
XYQ(1,IV) = XCBOX(IVBOX)
XYQ(2,IV) = YCBOX(IVBOX)
60 CONTINUE
AQUAD(IJBOX,IQ) = AREAQ(XYQ)
50 CONTINUE
IF (DEBUG(35)) THEN
WRITE(IOUT,FMT=6010) IJBOX,(IQ,(IQUAD(IJBOX,IQ,IV),IV=1,4),
+ AQUAD(IJBOX,IQ),IQ=1,4)
IF (ONLINE) WRITE(ITOUT,FMT=6010) IJBOX,
+ (IQ,(IQUAD(IJBOX,IQ,IV),IV=1,4),
+ AQUAD(IJBOX,IQ),IQ=1,4)
END IF
6010 FORMAT(1X,'BOX',I3,/,(1X,'QUAD',I2,' BOX NUMBERS',4I5,
+ 5X,'AREA',F10.0/))
40 CONTINUE
30 CONTINUE
C
C
RETURN
C
C---- MODE.NE.0. Calculate profiles and weights for spot with (pixel)
C coordinates XR,YR
C First deal with special case where spot lies in central box and
C within XCGCEN,YCGCEN of the film centre, in which case use the
C central box unaltered if the central box is really central
C
90 DELXC = ABS(XR-NECX)
DELYC = ABS(YR-NECY)
IF ((DELXC.LT.XCGCEN).AND.(DELYC.LT.YCGCEN).AND.CENTRAL) THEN
IPRNUM(1) = ICENBOX
WTPR(1) = 1.0
RETURN
END IF
ARMIN = 999999.0
XYR(1) = XR
XYR(2) = YR
ND = ND + 1
IQOPT = 0
DO 100 IQ = 1,4
DO 110 IV = 1,4
IVBOX = IQUAD(NSBOX,IQ,IV)
XYQ(1,IV) = XCBOX(IVBOX)
XYQ(2,IV) = YCBOX(IVBOX)
110 CONTINUE
ATEMP = AREA(XYR,XYQ)
ARDEL = ABS(AREA(XYR,XYQ)-AQUAD(NSBOX,IQ))
C WRITE(6,*)'AREA,AQUAD,ARDEL',ATEMP,AQUAD(NSBOX,IQ),ARDEL
IF (ARDEL.LT.ARMIN) THEN
ARMIN = ARDEL
IQOPT = IQ
END IF
IF (DEBUG(35).AND.ND.LT.NDEBUG(35)) THEN
WRITE(IOUT,FMT=6020) XR,YR,NSBOX,IQ,ATEMP,IQOPT
IF (ONLINE) WRITE(ITOUT,FMT=6020) XR,YR,NSBOX,IQ,ATEMP,IQOPT
END IF
100 CONTINUE
C
6020 FORMAT(1X,'XR,YR',2F6.0,' NSBOX',I3,' QUAD',I2,' AREA',F10.0,
+ ' IQOPT',I2)
C
IF (IQOPT.EQ.0) WRITE(6,*)'ERROR, NO BEST BOX'
NVBOX = 0
DO 120 IV = 1,4
IVBOX = IQUAD(NSBOX,IQOPT,IV)
IF (IVBOX.GT.0) NVBOX = NVBOX + 1
IPRNUM(IV) = IVBOX
XCV(IV) = XCBOX(IVBOX)
YCV(IV) = YCBOX(IVBOX)
C
C---- If using the central box, adjust the coordinates by XCGCEN,YCGCEN
C towards the centre of the quadrilateral, providing central box
C really is central (ie centred on direct beam)
C
IF (IVBOX.EQ.ICENBOX.AND.CENTRAL) THEN
DELXC = ABS(XR-XCBOX(IVBOX))
DELYC = ABS(YR-YCBOX(IVBOX))
IF ((DELXC.GT.XCGCEN).AND.(DELYC.GT.YCGCEN)) THEN
XCV(IV) = XCV(IV) + ISP(IQOPT)*XCGCEN
YCV(IV) = YCV(IV) + JSP(IQOPT)*YCGCEN
ELSE IF ((DELXC.GT.XCGCEN).AND.(DELYC.LT.YCGCEN)) THEN
XCV(IV) = XCV(IV) + ISP(IQOPT)*XCGCEN
YCV(IV) = YR
ELSE IF ((DELXC.LT.XCGCEN).AND.(DELYC.GT.YCGCEN)) THEN
XCV(IV) = XR
YCV(IV) = YCV(IV) + JSP(IQOPT)*YCGCEN
END IF
END IF
120 CONTINUE
C
IF (DEBUG(35).AND.ND.LT.NDEBUG(35)) THEN
WRITE(IOUT,FMT=6022) (IPRNUM(I),XCV(I),YCV(I),I=1,4)
IF (ONLINE) WRITE(ITOUT,FMT=6022)(IPRNUM(I),XCV(I),YCV(I),
+ I=1,4)
END IF
6022 FORMAT(1X,4(' Box',I3,' XC ',F7.1,' YC ',F7.1))
C
CALL PRWEIGHT(NVBOX,IPRNUM,XYR,XCV,YCV,WTPR)
C
DO 130 IV = 1,4
IF (DEBUG(35).AND.(ABS(WTPR(IV)).GT.1.5)) THEN
WRITE(6,*)'*** LARGE WEIGHT ***'
WRITE(6,*)'NSBOX,NVBOX',NSBOX,NVBOX
WRITE(6,*)'IPRNUM',IPRNUM
WRITE(6,*)'WEIGHTS',WTPR
WRITE(6,*)'XYR',XYR
WRITE(6,*)'XCV',XCV
WRITE(6,*)'YCV',YCV
WRITE(6,*)'XCGCEN,YCGCEN',XCGCEN,YCGCEN
GOTO 132
END IF
130 CONTINUE
132 CONTINUE
IF (DEBUG(35).AND.ND.LT.30) THEN
WRITE(IOUT,FMT=6030) NVBOX,IPRNUM,WTPR
IF (ONLINE) WRITE(ITOUT,FMT=6030) NVBOX,IPRNUM,WTPR
END IF
6030 FORMAT(1X,'Debgu output from VARPROF',/,1X,
+ 'Number of real profiles',I3,/,1X,
+ 'Box numbers',9I4,' Weights',9F6.2)
C
END
SUBROUTINE VDIFF(V3, V1, V2)
C =====
C
C Subroutine to subtract two vectors V1 and V2 to V3
C
REAL V1(3), V2(3), V3(3)
C
DO 100 I = 1, 3
V3(I) = V1(I) - V2(I)
100 CONTINUE
C
RETURN
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== VERSION ==
SUBROUTINE VERSION(IMGP)
IMPLICIT NONE
C
C---- Prints version number and detector type (determined by previous
C call to DET)
C
C ..
C .. Scalar arguments
LOGICAL IMGP
INTEGER LENSTR
EXTERNAL LENSTR
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
c-harvest
C&&*&& include ../inc/mharvest.f
INTEGER MAXMTZ
PARAMETER (MAXMTZ = 16)
C .. Scalars in common block /CHARVEST/ ..
CHARACTER HVERSION*80,ProjectName*20,DataSetName*20,
+ HBEAMLINE*10,Precipitant*80,
+ PNAME_COLS(MAXMTZ)*20,
+ DNAME_COLS(MAXMTZ)*20
C .. Scalars in common block /IHARVEST/ ..
LOGICAL USECWD,PNAMEgiven,DNAMEgiven,DOHARVEST
REAL PHhar,Hartemp,
+ HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
CHARACTER*3 MKDIRMODE,CHMODMODE
INTEGER KHFLMS
C ..
C .. Common block /CHARVEST/ ..
COMMON /CHARVEST/HVERSION,ProjectName,DataSetName,
+ HBEAMLINE,Precipitant,
+ PNAME_COLS,DNAME_COLS
C .. Common block /IHARVEST/ ..
COMMON /IHARVEST/USECWD,PHhar,Hartemp,KHFLMS,
+ PNAMEgiven,DNAMEgiven,DOHARVEST,
+ HARETA,HARDIV,HARDIH,MKDIRMODE,CHMODMODE
C ..
C&&*&& end_include ../inc/mharvest.f
c-harvest
c
c
IF (IMGP) THEN
c-harvest
HVERSION = 'Version 6.2.2'//
$ ' for Image plate and CCD'//
$ ' data 26 June 2002'
c-harvest
WRITE(IOUT,FMT=6000) HVERSION(1:lenstr(HVERSION))
IF (ONLINE) WRITE(ITOUT,FMT=6000) HVERSION(1:lenstr(HVERSION))
C socket stuff
c socket IF (SOCKLO) THEN
c socket WRITE(IOLINE,FMT=6000) HVERSION(1:lenstr(HVERSION))
c socket CALL WRITE_SOCKET(SERVERFD,11,IOLINE)
c socket ENDIF
ELSE
c-harvest
HVERSION = 'Version 5.21 for Film data 10/08/93'
c-harvest
WRITE(IOUT,FMT=6001)HVERSION(1:lenstr(HVERSION))
IF (ONLINE) WRITE(ITOUT,FMT=6001) HVERSION(1:lenstr(HVERSION))
END IF
6000 FORMAT(1X,'************ ',a,' ***********'/,1X,
+ 'A.G.W. Leslie, MRC Laboratory Of Molecular Biology,',
+ ' HILLS ROAD, CAMBRIDGE CB2 2QH, UK',/,1X,
+ 'E-mail andrew@mrc-lmb.cam.ac.uk',/,1X,
+ 'New auto-indexing using DPS due to Ingo Steller',
+ ' Robert Bolotovsky and Michael Rossmann',/,1X,
+ '(1998) J. Appl. Cryst. 30, 1036-1040'/,1X,
+ 'Original auto-indexing using REFIX due to Wolfgang Kabsch',
+ ' (Kabsch,W. (1993),',/,'J.Appl.Cryst. 24,795-800.)',/,1X,
+ 'X-windows interface using xdl_view due to John Campbell',
+ ' (Daresbury Laboratory, UK.)',/,1X,'(Campbell,J.W. (1995)',
+ ' J. Appl. Cryst. 28, 236-242.'//)
6001 FORMAT(1X,'************ ',a,' ***********',/,1X,
+ 'A.G.W. LESLIE, LMB CAMBRIDGE, UK',/,1X,
+ 'E-mail andrew@mrc-lmb.cam.ac.uk')
END
C
C
SUBROUTINE VMSCAL(V2, V1, SCAL)
C ======
C
C V2 = V1 * SCAL
C
IMPLICIT NONE
INTEGER I
REAL V1(3), V2(3), SCAL
C
DO 100 I = 1, 3
V2(I) = V1(I) * SCAL
100 CONTINUE
C
RETURN
C
END
SUBROUTINE VMSCLG(V2, V1, SCAL, N)
C ======
C
C Subroutine to multiply a vector V1 by SCAL to
C yield V2
C from MADNES
C
INTEGER N
REAL V1(N), V2(N), SCAL
C
DO 100 I = 1, N
V2(I) = V1(I) * SCAL
100 CONTINUE
C
RETURN
C
END
C
SUBROUTINE VNORM(V1, V2, IER)
C
C Normalize a vector of length 3
C V1 and V2 may be the same vector (same address)
C
IMPLICIT NONE
REAL V1(3), V2(3), R
INTEGER I, IER
C
IER = -1
R = SQRT(V1(1)**2 + V1(2)**2 + V1(3)**2)
IF (R .NE. 0.0) THEN
DO 100 I = 1, 3
V2(I) = V1(I) / R
100 CONTINUE
IER = 0
ENDIF
RETURN
END
SUBROUTINE VSUB(V1,V2,V3)
C ====
C
C V1 = V2 - V3
C
IMPLICIT NONE
INTEGER I
REAL V1(3), V2(3), V3(3)
C
DO 100 I = 1, 3
V1(I) = V2(I) - V3(I)
100 CONTINUE
C
RETURN
C
END
C== WARNINGS ==
SUBROUTINE WARNINGS
C
IMPLICIT NONE
C Write warning messages to summary file
C
C 1) Spot overlap. XWARN(1-4,1) size of spot in centre of image
C and largest standard profile. MASKIT
C
C 2) ROFF unstable. XWARN(1,2) is variation.MOSFLM
C
C 3) CCOMEGA unstable.XWARN(1,3) is variation. MOSFLM
C
C 4) Not enough spots for refinement. MOSFLM
C
C 5) Crystal slippage from one image to next is greater than
C 0.25*(sum of mosaic spread and divergence).
C XWARN(1,5) is max slippage.MOSFLM
C
C 6) Large weighted residual. XWARN(1,6) = WRMAX. MOSFLM
C
C 7) Too many badspots (>10). IWARN(1,7) = max number. MOSFLM
C
C 8) Profile averaging. PROCESS
C
C 9) BGRATIO outside range 0.9 to 1.1. XWARN(1,9) = min value
C XWARN(2,9) = max value MOSFLM
C
C 10) Too many spots with too few background points (>5)
C IWARN(1,10) = value
C NBADBG in PROCESS
C
C 11) Profiles have long tails...optimisation of raster parameters
C may not be optimal. More than 30% of peak pixels have values
C less than 5% of peak value. XWARN(1,11) = %age (PROCESS/PRUPDATE)
C
C 12) TOFF unstable XWARN(1,12) = variation. (MOSFLM)
C
C 13) More than 5% variation in apparent exposure times of
C successive images as judged by background of spots used in post-
C refinement. This means ADDPART cannot be used.
C XWARN(13),IWARN(1etc,13) = image value
C (Set in POSTREFL)
C
C 14) Spots in central region with zero value pixels. WARN(14)
C (Set in NEXT)
C
C 15) Fraction of spots that are fully recorded less than 0.2 AND
C total number of fulls less than 100, or number of fulls is
C less than 60, and not using ADDPART.
C Set in GENERATE. WARN(15)
C
C 16) Negative refined (mosaic spread+divergence).
C Set in MOSFLM. WARN(16)
C
C 17) Too many background points rejected...may be due to GAIN being
C set too low, or simply diffuse scatter.
C Set in PROCESS. WARN(17)
C
C 18) Large sd's in cell parameters. More than 0.1A for cell edges
C or 0.1 degrees for cell angle. Set in MOSFLM.
C
C 19) Refined mosaic spread or beam divergence differs from input
C value by more than 10% of input value, and refined value is NOT
C being used. Set in MOSFLM (main).
C
C 20) Summed profile OUTSIDE the peak area is greater than 10% of
C sum of profile inside the peak
C Set in PROCESS
C
C 21) More than 50% of background pixels overlapped by neighbouring spots
C for some profile on some images.
C
C 22) Program has automatically included partials in refinement.
C Set in MOSFLM
C
C 23) Program has automatically included partials in profiles.
C Set in MOSFLM
C
C 24) Rather few reflections for post-refinement of cell (Set in
C IDXREF).
C
C 25) YSCAL differs from nominal value by more than 0.1%. (Set in
C MOSFLM). Error in XWARN(1,25)
C
C 26) Fewer than NPRMIN partials extending over 2 images, so no
C post-refinement will be possible.
C Set in GENERATE.
C
C 27) IPAD (used to set up IRFLAG) set to 100, so need to use
C new version of SCALA or turn CHECK off.
C
C 28) Note enough background pixels forcing reduction of RECLEVEL
C (set in GETMOREBG)
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,K,NBAD,ILIM,IPR
LOGICAL WARNING
CHARACTER STR*80
C ..
C ..
C .. External Functions ..
INTEGER LENSTR
EXTERNAL LENSTR
C ..
C .. External Subroutines ..
EXTERNAL XDLF_FLUSH_EVENTS
C
C .. Common blocks ..
C&&*&& include ../inc/backg.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file backg.h
C---- START of include file backg.h
C
C
C
C .. Scalars in common block /BACKG/ ..
REAL BGFRAC
INTEGER NBGMIN
C ..
C .. Common Block /BACKG/ ..
COMMON /BACKG/ BGFRAC,NBGMIN
C ..
C
C
C&&*&& end_include ../inc/backg.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/dsplyc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file dsplyc.h
C---- START of include file dsplyc.h
C
C*******************************************************************
C
C COMMON /DSPLYC/
C
C IMGLOW, IMGHI low & high values of 16-bit image for scaling
C integer*2 to byte: IMGLOW maps to 0;
C IMGHI to maximum. Note that these are not
C necessarily the actual limits of the data
C JDSPWD .LT. 0 before image window has been created
C = +-1 for image display that can be panned
C = +-2 for non-interactive image display
C MAXDEN highest level in colour table to fill up to
C must be less than ~240 - number of overlay colours
C LDSPSG if .true., treat image as signed, ie after dark
C subtraction
C if .false., treat image as unsigned
C NZOOM zoom factor for image, = 0 if no zoom
C JYZOOM, JZZOOM 1st pixel in zoomed image
C
C---- WINOPEN Flag for whether or not window is open. Do not
C confuse with DISPMENU (/CONDATA/)which is true if the run was
C started with a IMAGE keyword.
C
C
C CDSPTL banner title
C
INTEGER IMGLOW, IMGHI, JDSPWD, MAXDEN,
$ NZOOM, JYZOOM, JZZOOM
LOGICAL LDSPSG,WINOPEN,LPAUSE,LHELP
COMMON /DSPLYC/ IMGLOW, IMGHI, JDSPWD,
* MAXDEN, NZOOM, JYZOOM, JZZOOM, LDSPSG,WINOPEN,LPAUSE,LHELP
C
CHARACTER CDSPTL*200
COMMON /DSPLCC/ CDSPTL
C
C
C*******************************************************************
C&&*&& end_include ../inc/dsplyc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/myprof.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file myprof.h
C---- START of include file myprof.h
C
C
C .. Arrays in Common Block /MYPROF/ ..
REAL PRSCALE,XPMAX,YPMAX,XLINE,YLINE,WPROFL,WPRSUMS
INTEGER ISIZE,NRFBOX,IPROFL,IBOX,IXBOX,IYBOX,NPFIRST
LOGICAL BOX
C ..
C .. Scalars in Common Block /MYPROF/
REAL TOL,BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL
INTEGER NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,NOVERLAP
LOGICAL HIGHRES,LOWRES,PRSET,OFFDET,PROPT,FIXBOX,LINESET,
+ PROPTCEN,RECOVER,NOFIXBOX
C ..
C .. Common Block /MYPROF/ ..
COMMON /MYPROF/PRSCALE(NMASKS,2),XPMAX(NMASKS),YPMAX(NMASKS),
$ XLINE(NNLINE),YLINE(NNLINE),
+ WPROFL(MAXBOX,NMASKS),WPRSUMS(MAXBOX,NMASKS),TOL,
+ BGPKRAT,FRACREJ,BADTOL,TOLMIN,RECLEVEL,
$ ISIZE(NMASKS,2),NRFBOX(NMASKS),
+ IPROFL(MAXBOX,NMASKS+1),IBOX(0:NNLINE,0:NNLINE),
+ IXBOX(NMASKS,2),IYBOX(NMASKS,2),
+ NPFIRST(NNLINE-1),NXLINE,NYLINE,NUMBOX,IBOUND,ITRIM,
$ NOVERLAP,BOX(NMASKS),HIGHRES,LOWRES,PRSET,OFFDET,
+ PROPT,FIXBOX,LINESET,PROPTCEN,RECOVER,NOFIXBOX
C ..
C
C
C&&*&& end_include ../inc/myprof.f
C&&*&& include ../inc/over.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file over.h
C---- START of include file over.h
C
C
C .. Scalars in Common Block /OVER/ ..
C
C ..
C .. Scalars in common /OVER/ ..
INTEGER MINDTX,MINDTY,NPOVL,IXSEP,IYSEP
C ..
C .. ARRAYS in common /OVER/ ..
INTEGER HKLPOVL
C ..
C .. Common Block /OVER/ ..
COMMON /OVER/MINDTX,MINDTY,NPOVL,IXSEP,IYSEP,HKLPOVL(NREFLS/2)
C ..
C
C
C&&*&& end_include ../inc/over.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/parm1.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm1.h
C---- START of include file parm1.h
C
C
C
C .. Scalars in common block /PARM1/ ..
REAL BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,BGRAT,PKRAT,
+ RESD,RESDLOW
INTEGER CUTOFF,NOVPIX,NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX
LOGICAL DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C .. Common Block /PARM1/ ..
COMMON /PARM1/BGSIG,EFAC,EFACSQ,BGFREJ,GRADMAX,GRADMAXR,
+ BGRAT,PKRAT,RESD,RESDLOW,CUTOFF,NOVPIX,
+ NDSTART,NDTOT,IXDMIN,IXDMAX,IYDMIN,IYDMAX,
+ IDMIN,IDMAX,DUMPSPOT,BADPLOT,DUMPALL,BADPLOT2
C ..
C
C
C&&*&& end_include ../inc/parm1.f
C&&*&& include ../inc/parm2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parm2.h
C---- START of include file parm2.h
C
C
C .. Scalars in common block /PARM2/ ..
REAL PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,PKWDLIM3,PKWDOUTL
INTEGER ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2
LOGICAL PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,PUPDATE,PKONLY,DENSE,PRFULLS,
+ DECONV
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
INTEGER IHD
C ..
C .. Common Block /PARM2/ ..
COMMON /PARM2/PRBGSIG,RMSBGPR,DISCRIM,PKWDLIM1,PKWDLIM2,
$ PKWDLIM3,PKWDOUTL,
$ ISDRATIO,PRCUTOFF,IPLOT,NRFMIN,NHKLD,IOUTL1,IOUTL2,
$ IHD(3,50),
$ PROFILE,PROCES,SAVEFILE,CHANGEMASK,PRBFILM,PRCFILM,
+ PRREAD,PRSAVE,WEIGHT,
+ PRPART,USEOVRLD,USEDGE,VARPRO,
+ WTPROFILE,DISCRIMINATE,
+ PUPDATE,PKONLY,DENSE,
+ PRFULLS,DECONV
C ..
C
C
C&&*&& end_include ../inc/parm2.f
C&&*&& include ../inc/postchk.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file postchk.h
C---- START of include file postchk.h
C
C DELPHIV stores the missets for the first NADD images only,
C so that once NADD images have been processed their
C refined missets can be saved for writing to the
C summary file.
C
C .. Arrays in Common /POSTCHK/
REAL SDBEAM,SDCELL,SDDELPHI,DELPHIV,SHIFT
LOGICAL FCELL
C
C .. Scalars in Common /POSTCHK/ ..
C ..
REAL PRRES1,PRRES2,RESIDMAX,SDFAC,SHIFTMAX,SHIFTFAC,
+ ANGWIDTH,CELLSHIFT,FRACMIN,FRACMAX,FRCSHIFT
INTEGER PRNS,NREFPR,NADD,NRPT,IPRINTP,NPRMIN
LOGICAL USEBEAM,REFCELL
C ..
C .. Common block /POSTCHK/ ..
COMMON /POSTCHK/ SDBEAM(6),SDCELL(6),SDDELPHI(2*NIMAX),
+ DELPHIV(3*NIMAX),SHIFT(3),PRRES1,PRRES2,RESIDMAX,
+ SDFAC,SHIFTMAX,SHIFTFAC,ANGWIDTH,CELLSHIFT,
$ FRACMIN,FRACMAX,FRCSHIFT,
+ PRNS,NREFPR,NADD,NRPT,IPRINTP,
+ NPRMIN,FCELL(6),USEBEAM,REFCELL
C ..
C
C
C&&*&& end_include ../inc/postchk.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
SAVE
C ..
IF (WINOPEN) CALL XDLF_FLUSH_EVENTS(I)
WARNING = .FALSE.
DO 10 I=1,50
IF (WARN(I)) WARNING = .TRUE.
10 CONTINUE
C
C---- For information only
C
IF (WARN(22).OR.WARN(23)) THEN
WRITE(ISUMMR,FMT=6200)
WRITE(IOUT,FMT=6200)
IF (ONLINE) WRITE(ITOUT,FMT=6200)
C
IF (WARN(22).AND.(.NOT.WARN(23))) THEN
WRITE(IOUT,FMT=6090) IWARN(1,22),PTMIN
WRITE(ISUMMR,FMT=6090) IWARN(1,22),PTMIN
IF (ONLINE) WRITE(ITOUT,FMT=6090) IWARN(1,22),PTMIN
IF (.NOT.PRFULLS) THEN
WRITE(IOUT,FMT=6091)
WRITE(ISUMMR,FMT=6091)
IF (ONLINE) WRITE(ITOUT,FMT=6091)
END IF
END IF
IF (WARN(23)) THEN
WRITE(IOUT,FMT=6092) PTMIN
WRITE(ISUMMR,FMT=6092) PTMIN
IF (ONLINE) WRITE(ITOUT,FMT=6092) PTMIN
END IF
END IF
C
IF (WARNING) THEN
WRITE(ISUMMR,FMT=6000)
WRITE(IOUT,FMT=6000)
IF (ONLINE) WRITE(ITOUT,FMT=6000)
C----- IPAD
IF (WARN(27)) THEN
WRITE(ISUMMR,FMT=6100) WMAX
WRITE(IOUT,FMT=6100) WMAX
IF (ONLINE) WRITE(ITOUT,FMT=6100) WMAX
END IF
C---- ADDPART
IF ((WARN(2).OR.WARN(3).OR.WARN(12)).AND.ADDPART) THEN
WRITE(ISUMMR,FMT=6007)
WRITE(IOUT,FMT=6007)
IF (ONLINE) WRITE(ITOUT,FMT=6007)
END IF
C---- ROFF
IF (WARN(2).AND.IMGP) THEN
WRITE(ISUMMR,FMT=6004) XWARN(1,2),RAST
WRITE(IOUT,FMT=6004) XWARN(1,2),RAST
IF (ONLINE) WRITE(ITOUT,FMT=6004) XWARN(1,2),RAST
IF ((.NOT.FIXPAR(10)).OR.(.NOT.FIXPAR(11))) THEN
WRITE(ISUMMR,FMT=6005)
WRITE(IOUT,FMT=6005)
IF (ONLINE) WRITE(ITOUT,FMT=6005)
END IF
END IF
C---- TOFF
IF (WARN(12).AND.IMGP) THEN
WRITE(ISUMMR,FMT=6034) XWARN(1,12)
WRITE(IOUT,FMT=6034) XWARN(1,12)
IF (ONLINE) WRITE(ITOUT,FMT=6034) XWARN(1,12)
IF (ADDPART) THEN
WRITE(ISUMMR,FMT=6035)
WRITE(IOUT,FMT=6035)
IF (ONLINE) WRITE(ITOUT,FMT=6035)
END IF
END IF
C---- CCOMEGA
IF (WARN(3)) THEN
WRITE(ISUMMR,FMT=6006) XWARN(1,3)
WRITE(IOUT,FMT=6006) XWARN(1,3)
IF (ONLINE) WRITE(ITOUT,FMT=6006) XWARN(1,3)
WRITE(ISUMMR,FMT=6106)
WRITE(IOUT,FMT=6106)
IF (ONLINE) WRITE(ITOUT,FMT=6106)
END IF
C---- Too few spots in CENTRS
IF (WARN(4)) THEN
WRITE(ISUMMR,FMT=6008)
WRITE(IOUT,FMT=6008)
IF (ONLINE) WRITE(ITOUT,FMT=6008)
END IF
C---- Slippage > (eta + divv)
IF (WARN(5)) THEN
WRITE(ISUMMR,FMT=6010) XWARN(1,5)
WRITE(IOUT,FMT=6010) XWARN(1,5)
IF (ONLINE) WRITE(ITOUT,FMT=6010) XWARN(1,5)
END IF
C---- Weighted residual > 1.5
IF (WARN(6)) THEN
WRITE(ISUMMR,FMT=6012) XWARN(1,6)
WRITE(IOUT,FMT=6012) XWARN(1,6)
IF (ONLINE) WRITE(ITOUT,FMT=6012) XWARN(1,6)
END IF
C---- Spot overlap
IF (WARN(1)) THEN
WRITE(ISUMMR,FMT=6002) 0.01*IXSEP,0.01*IYSEP,
+ (XWARN(K,1),K=1,4),TOL
WRITE(IOUT,FMT=6002) 0.01*IXSEP,0.01*IYSEP,
+ (XWARN(K,1),K=1,4),TOL
IF (ONLINE) WRITE(ITOUT,FMT=6002) 0.01*IXSEP,0.01*IYSEP,
+ (XWARN(K,1),K=1,4),TOL
IF (.NOT.DENSE) THEN
WRITE(ISUMMR,FMT=6003)
WRITE(IOUT,FMT=6003)
IF (ONLINE) WRITE(ITOUT,FMT=6003)
END IF
END IF
C---- Too many badspots (>10)
IF (WARN(7)) THEN
WRITE(ISUMMR,FMT=6014) IWARN(1,7)
WRITE(IOUT,FMT=6014) IWARN(1,7)
IF (ONLINE) WRITE(ITOUT,FMT=6014) IWARN(1,7)
END IF
C---- Profile averaging
IF (WARN(8)) THEN
WRITE(ISUMMR,FMT=6016)
WRITE(IOUT,FMT=6016)
IF (ONLINE) WRITE(ITOUT,FMT=6016)
END IF
C---- BGRATIO too large or too small
IF (WARN(9)) THEN
IF (IMGP) THEN
WRITE(ISUMMR,FMT=6018) XWARN(1,9),XWARN(2,9)
WRITE(IOUT,FMT=6018) XWARN(1,9),XWARN(2,9)
IF (ONLINE) WRITE(ITOUT,FMT=6018) XWARN(1,9),XWARN(2,9)
ELSE
WRITE(ISUMMR,FMT=6020) XWARN(1,9),XWARN(2,9)
WRITE(IOUT,FMT=6020) XWARN(1,9),XWARN(2,9)
IF (ONLINE) WRITE(ITOUT,FMT=6020) XWARN(1,9),XWARN(2,9)
END IF
END IF
C---- Too many spots with too few background points
IF (WARN(10)) THEN
WRITE(ISUMMR,FMT=6022) IWARN(1,10),NBGMIN,BGSIG
WRITE(IOUT,FMT=6022) IWARN(1,10),NBGMIN,BGSIG
IF (ONLINE) WRITE(ITOUT,FMT=6022) IWARN(1,10),NBGMIN,BGSIG
IF (WARN(1)) THEN
WRITE(ISUMMR,FMT=6024)
WRITE(IOUT,FMT=6024)
IF (ONLINE) WRITE(ITOUT,FMT=6024)
ELSE
WRITE(ISUMMR,FMT=6026)
WRITE(IOUT,FMT=6026)
IF (ONLINE) WRITE(ITOUT,FMT=6026)
IF (WARN(9)) THEN
WRITE(ISUMMR,FMT=6028)
WRITE(IOUT,FMT=6028)
IF (ONLINE) WRITE(ITOUT,FMT=6028)
ELSE
WRITE(ISUMMR,FMT=6030)
WRITE(IOUT,FMT=6030)
IF (ONLINE) WRITE(ITOUT,FMT=6030)
END IF
END IF
END IF
C---- Profiles have long tails
IF (WARN(11)) THEN
WRITE(ISUMMR,FMT=6032) 100.0*XWARN(1,11),TOL
WRITE(IOUT,FMT=6032) 100.0*XWARN(1,11),TOL
IF (ONLINE) WRITE(ITOUT,FMT=6032)100.0*XWARN(1,11),TOL
END IF
C
C---- Adjacent images have exposures differing by more than 5% (as
C judged from background of spots in post-refinement
C
IF (WARN(13).AND.ADDPART) THEN
NBAD = IWARN(1,13)
WRITE(IOUT,FMT=6036) NBAD
IF (ONLINE) WRITE(ITOUT,FMT=6036) NBAD
WRITE(ISUMMR,FMT=6036) NBAD
WRITE(IOUT,FMT=6038) (IWARN(I,13),I=2,NBAD+1)
IF (ONLINE) WRITE(ITOUT,FMT=6038) (IWARN(I,13),I=2,NBAD+1)
WRITE(IOUT,FMT=6040) (XWARN(I,13),I=2,NBAD+1)
IF (ONLINE) WRITE(ITOUT,FMT=6040) (XWARN(I,13),I=2,NBAD+1)
WRITE(ISUMMR,FMT=6038) (IWARN(I,13),I=2,NBAD+1)
WRITE(ISUMMR,FMT=6040) (XWARN(I,13),I=2,NBAD+1)
END IF
C
C---- Spots in central region with zero pixel values
C
IF (WARN(14).AND.(.NOT.TILED).AND.(NULLPIX.EQ.0)) THEN
ILIM = NINT(0.01*LIMIT)
WRITE(IOUT,FMT=6042) NULLPIX, NULLPIX,ILIM,
+ NULLPIX
IF (ONLINE) WRITE(ITOUT,FMT=6042) NULLPIX, NULLPIX,ILIM,
+ NULLPIX
WRITE(ISUMMR,FMT=6042) NULLPIX, NULLPIX,ILIM,
+ NULLPIX
END IF
C
C---- Not many fully recorded reflections
C
IF (WARN(15).AND.(.NOT.USEPAR)) THEN
WRITE(IOUT,FMT=6044)
IF (ONLINE) WRITE(ITOUT,FMT=6044)
WRITE(ISUMMR,FMT=6044)
END IF
C
C---- Negative refined (mosaic spread + beam divergence)
C
IF (WARN(16)) THEN
WRITE(IOUT,FMT=6046)
IF (ONLINE) WRITE(ITOUT,FMT=6046)
WRITE(ISUMMR,FMT=6046)
IF (PRNS.EQ.2) THEN
WRITE(IOUT,FMT=6048)
IF (ONLINE) WRITE(ITOUT,FMT=6048)
WRITE(ISUMMR,FMT=6048)
END IF
IF (USEBEAM) THEN
IF (PRNS.EQ.1) THEN
WRITE(IOUT,FMT=6050)
IF (ONLINE) WRITE(ITOUT,FMT=6050)
WRITE(ISUMMR,FMT=6050)
ELSE
WRITE(IOUT,FMT=6052)
IF (ONLINE) WRITE(ITOUT,FMT=6052)
WRITE(ISUMMR,FMT=6052)
END IF
END IF
END IF
C
C---- Too many background pixels rejected . DISABLE THIS TEST, IT DOESNT
C REALLY WORK
CAL IF (WARN(17)) THEN
CAL WRITE(IOUT,FMT=6054) BGSIG
CAL IF (ONLINE) WRITE(ITOUT,FMT=6054) BGSIG
CAL END IF
IF (WARN(18)) THEN
C
C---- Find out which cell parameters are poorly determined
C
STR = ' '
IF (IWARN(1,18).EQ.1)STR=STR(1:MAX(1,LENSTR(STR)))//' A'
IF (IWARN(2,18).EQ.1)STR=STR(1:MAX(1,LENSTR(STR)))//' B'
IF (IWARN(3,18).EQ.1)STR=STR(1:MAX(1,LENSTR(STR)))//' C'
IF (IWARN(4,18).EQ.1)STR=STR(1:MAX(1,LENSTR(STR)))//' ALPHA'
IF (IWARN(5,18).EQ.1)STR=STR(1:MAX(1,LENSTR(STR)))//' BETA'
IF (IWARN(6,18).EQ.1)STR=STR(1:MAX(1,LENSTR(STR)))//' GAMMA'
WRITE(IOUT,FMT=6056) STR(1:MAX(1,LENSTR(STR))),
+ (XWARN(I,18),I=1,6)
IF (ONLINE) WRITE(ITOUT,FMT=6056) STR(1:MAX(1,LENSTR(STR))),
+ (XWARN(I,18),I=1,6)
WRITE(ISUMMR,FMT=6056) STR(1:MAX(1,LENSTR(STR))),
+ (XWARN(I,18),I=1,6)
END IF
IF (WARN(19).AND.(.NOT.USEBEAM)) THEN
IF (PRNS.EQ.1) THEN
WRITE(IOUT,FMT=6058)
IF (ONLINE) WRITE(ITOUT,FMT=6058)
WRITE(ISUMMR,FMT=6058)
ELSE IF (PRNS.EQ.2) THEN
WRITE(IOUT,FMT=6060)
IF (ONLINE) WRITE(ITOUT,FMT=6060)
WRITE(ISUMMR,FMT=6060)
END IF
END IF
IF (WARN(20)) THEN
I = IWARN(1,20)
IPR = MIN(I,19) + 1
WRITE(IOUT,FMT=6070) I
WRITE(ISUMMR,FMT=6070) I
IF (ONLINE) WRITE(ITOUT,FMT=6070) I
IF (ADDPART) THEN
WRITE(IOUT,FMT=6073)
WRITE(ISUMMR,FMT=6073)
IF (ONLINE) WRITE(ITOUT,FMT=6073)
END IF
IF (TOL.GT.0.03) THEN
WRITE(IOUT,FMT=6072) TOL
WRITE(ISUMMR,FMT=6072) TOL
IF (ONLINE) WRITE(ITOUT,FMT=6072) TOL
END IF
WRITE(IOUT,FMT=6074) (IWARN(K,20),K=2,IPR)
WRITE(ISUMMR,FMT=6074) (IWARN(K,20),K=2,IPR)
IF (ONLINE) WRITE(ITOUT,FMT=6074) (IWARN(K,20),K=2,IPR)
WRITE(IOUT,FMT=6076) (XWARN(K,20),K=2,IPR)
WRITE(ISUMMR,FMT=6076) (XWARN(K,20),K=2,IPR)
IF (ONLINE) WRITE(ITOUT,FMT=6076) (XWARN(K,20),K=2,IPR)
END IF
IF (WARN(21).AND.(.NOT.DENSE)) THEN
WRITE(IOUT,FMT=6080) 100.0*XWARN(1,21)
WRITE(ISUMMR,FMT=6080) 100.0*XWARN(1,21)
IF (ONLINE) WRITE(ITOUT,FMT=6080) 100.0*XWARN(1,21)
END IF
IF (WARN(24)) THEN
WRITE(IOUT,FMT=6094)
WRITE(ISUMMR,FMT=6094)
IF (ONLINE) WRITE(ITOUT,FMT=6094)
END IF
IF (WARN(25)) THEN
WRITE(IOUT,FMT=6096) XWARN(1,25)
WRITE(ISUMMR,FMT=6096) XWARN(1,25)
IF (ONLINE) WRITE(ITOUT,FMT=6096) XWARN(1,25)
END IF
IF (WARN(26)) THEN
WRITE(IOUT,FMT=6098) NPRMIN
WRITE(ISUMMR,FMT=6098) NPRMIN
IF (ONLINE) WRITE(ITOUT,FMT=6098) NPRMIN
END IF
IF (WARN(28)) THEN
WRITE(IOUT,FMT=6102) NBGMIN,RECLEVEL
WRITE(ISUMMR,FMT=6102) NBGMIN,RECLEVEL
IF (ONLINE) WRITE(ITOUT,FMT=6102) NBGMIN,RECLEVEL
END IF
C
C---- reset all warning flags and values
C
DO 20 I = 1,100
WARN(I) = .FALSE.
DO 22 K=1,20
IWARN(K,I) = 0
XWARN(K,I) = 0.0
22 ENDDO
20 ENDDO
END IF
RETURN
6000 FORMAT(//,1X,'*** Warning messages ***')
6002 FORMAT(/,1X,'SPOT OVERLAP',/,1X,'============',/,1X,
+ 'Adjacent spots overlap. This will produce ',
+ 'systematic errors in the intensities.'
+ ,/,1X,'Note that this',
+ ' warning will arise even if only one pair of spots in',
+ /,1X,'one area of the detector overlap. Look at the ',
+ 'standard profiles',
+ ' to see how',/,1X,'serious the overlap is.',/,1X,
+ 'The minimum allowed spot separation (SEPARATION keyword)',
+ ' was ',2F4.1,'mm.',/,1X,'The actual spot size determined',
+ ' by the mask optimisation is',F4.1,' by',F4.1,'mm',/,1X,
+ 'in the centre of the image and the largest spot size is',
+ F4.1,' by',F4.1,'mm.',/,1X,'The separation given '
+ ,'should be at least as large as the spot size',/,1X,
+ 'in the centre of the image (keyword SEPARATION).',/,1X,
+ 'Check standard profiles carefully to ensure that the ',
+ 'optimisation of the',/,1X,'raster parameters has worked',
+ ' correctly.',/,1X,'The effective size',
+ ' of the spots can be controlled by PROFILE TOLERANCE ',
+ /,1X,'keywords. If the peak regions look too large (ie',
+ ' they include too much of the',/,1X,'tails of the spot)',
+ ', try increasing TOLERANCE (current value',F6.3,
+ ') by',/,1X,'eg 0.005 ',
+ 'and see if profiles look better.',/,1X,
+ '(Increasing TOLERANCE will'
+ ,' decrease spot size).'/,1X,'As a last resort the profile',
+ ' optimisation can be turned off ',
+ 'using keywords',/,1X,'PROFILE NOOPT.')
6003 FORMAT(/,1X,'In cases of serious overlap, (ie if the pattern',
+ 'is very dense), then the',/,1X,'SEPARATION CLOSE option',
+ ' should be used (eg SEPARATION 1.0 1.0 CLOSE)',/,1X,
+ 'and it may also help to suppress profile optimisation',
+ ' in these cases',/,1X,'(PROFILE NOOPT)',
+ 'keyword. See help library for details.')
6004 FORMAT(/,1X,'RADIAL OFFSET UNSTABLE',/,1X,'====================',
+ '==',/,1X,'The radial',
+ ' offset parameter (ROFF) is varying more than it should.'
+ ,/,1X,'(Maximum variation is',F6.2,'mm)',/,1X,
+ 'If the variation is random, it may be due to weak ',
+ 'data.',/,1X,'In this case, it is best to fix the ',
+ 'ROFF parameter: REFINEMENT FIX ROFF',/,1X,'If known',
+ ' the correct value can be input: DISTORTION ROFF 0.11',
+ 'If not known, the mean refined value can be used.',/,1X,
+ 'In such cases TOFF should also be FIXED.',/,1X,
+ 'If the ROFF values',/,1X,'fall into two or',
+ ' more sets of values which differ by one pixel (',F4.2,
+ 'mm)',
+ /,1X,'then there may be a problem with the',
+ ' locking mechanism of the scanner.'/,1X,'Instability',
+ ' in TOFF may also cause large changes in ROFF.')
6005 FORMAT(1X,'Try',
+ ' fixing RDROFF and RDTOFF first with keywords:',/,1X,
+ 'REFINEMENT FIX RDROFF RDTOFF.',/,1X,'It may also ',
+ 'be necessary to fix TOFF (but then the correct value',
+ /,1X,'for this scanner should be specified using ',
+ 'keywords DISTORTION TOFF x).')
6006 FORMAT(/,1X,'CCOMEGA UNSTABLE',/,1X,'================',/,1X,
+ 'The',
+ ' parameter CCOMEGA is varying more than it should.',
+ /,1X,'(Maximum variation is',F6.2,' degrees)',/,1X,
+ /,1X,'This could be due to crystal slippage (look at ',
+ ' summary file) in which',/,1X,'case the intensities of',
+ ' partially recorded reflections may have serious ',
+ /,1X,'errors (check by using FULLS ONLY in ',
+ 'SCALA/AGROVATA)',/,
+ /,1X,'It may be also due to poor positional refinement',
+ ' if the images are weak',/,1X,'OR there are',
+ ' not many spots on each image.')
6106 FORMAT(1X,'If there',
+ ' are large changes in both TOFF, ROFF and CCOMEGA, this ',
+ 'suggests',/,1X,'that the refinement is unstable and ',
+ 'ROFF and TOFF should not be refined.',/,1X,'To do this use',
+ ' keywords: REFINEMENT FIX ROFF TOFF.',/,1X,'The correct ',
+ 'values for this scanner should be specified using ',
+ 'keywords:',/,1X,'DISTORTION TOFF 0.13',
+ ' ROFF 0.03 (for example).',/,1X,'It is NOT ',
+ 'recommended to FIX CCOMEGA as well (REFINEMENT FIX CCOMEGA).',
+ /,1X,'as CCOMEGA allows for crystal slippage around',
+ ' the X-ray beam direction.')
6007 FORMAT(//,1X,' **** IMPORTANT ****',/,1X,'The ADDPART option ',
+ 'MUST NOT be used if ROFF or TOFF are unstable',/,1X,
+ 'Turn it off using keyword ADDPART OFF')
6008 FORMAT(/1X,'NOT ENOUGH SPOTS FOR REFINEMENT',/,1X,
+ '===============================',/,1X,
+ 'Refinement failed because there were not enough ',
+ 'spots found in the central region',/,1X,'of the ',
+ 'detector. This is almost certainly because of errors',
+ ' in the ',/,1X,'camera constants (beam position or ',
+ 'CCOMEGA) or in the prediction for',/,1X,'this image',
+ '. You are strongly advised to use the graphics option',
+ ' to find the source of the error.')
6010 FORMAT(/,1X,'CRYSTAL SLIPPAGE',/,1X,'================',/,1X,
+ 'There is significant slippage between successive',
+ ' images',/,1X,'(Maximum slippage is',F8.2,' degrees',
+ ' which is more than a quarter of the sum',/,1X,
+ 'of the beam divergence and mosaic spread.',/,1X,
+ 'There may be serious errors in the intensities of ',
+ 'partially recorded',/,1X,'reflections. This can',
+ ' be checked by merging only fully recorded ',
+ 'reflections',/,1X,'in SCALA/AGROVATA. ',
+ 'In extreme cases it may be helpful to increase ',
+ 'the',/,1X,'mosaic spread or beam divergence parameters',
+ ' to improve processing.')
6012 FORMAT(/,1X,'LARGE WEIGHTED RESIDUAL',/,1X,
+ '=======================',/,1X,
+ 'The weighted residual is rather large (it should ',
+ 'be unity, actual maximum value',F5.2,').',
+ /,1X,'This is usually due to poor cell ',
+ 'parameters..check these and possibly try ',
+ 'post-refinement')
6014 FORMAT(/,1X,'EXCESSIVE NUMBER OF BADSPOTS',/,1X,
+ '============================',/,1X,
+ 'At least some images have rather a lot of ',
+ 'badspots (Maximum number',I4,')',
+ /,1X,'They are rejected on the basis of: ',
+ /,1X,'1) Poor profile fit (PKRATIO >3, ',
+ 'controlled by REJECTION PKRATIO).',/,1X,
+ '2) Too large a BGRATIO (too much background variation',
+ ', controlled by',/,3X,' REJECTION BGRATIO).',/,1X,
+ '3) Too large a background gradient (controlled by',
+ ' REJECTION GRADMAX)',/,1X,'4) Intensity',
+ ' negative and more than 5 sigma.',/,1X,'Look at the ',
+ 'list of badspots to see what category they fall under.',
+ //,1X,'Poor profile fit is often the result of changes',
+ ' in ROFF, TOFF or CCOMEGA',/,1X,'between ',
+ 'successive images when using the ADDPART option.',
+ /,1X,'Very intense images can have unusually large ',
+ 'gradients, GRADMAX may have to',/,1X,'be changed ',
+ 'from the default',/,1X,'A pixel dump of the BADSPOTS',
+ ' can be obtained using REJECTION PLOT',/,1X,'if the ',
+ 'reason for their rejection is not clear')
6016 FORMAT(/1X,'AVERAGING OF STANDARD PROFILES',/,1X,
+ '==============================',/,1X,
+ 'Profile averaging has been performed for some ',
+ 'of the standard profiles.',/,1X,'If possible this should'
+ ,' be avoided, eg by accumulating the profiles',/,1X,
+ 'over more images (BLOCK parameter on PROCESS keyword).',
+ /,1X,'Do not attempt to process spots that are',
+ ' not really there !',/,1X,'If profiles are being ',
+ 'averaged because the RMSBG is too high, but ',/,1X,
+ 'this is because of diffuse scatter, it is best to',
+ ' increase the maximum ',/,1X,'allowed RMSBG (default',
+ ' value 10.0): PROFILE RMSBG 20 (for example).')
6018 FORMAT(/1X,'OVERALL BACKGROUND RATIO (BGRATIO)',/,1X,
+ '==================================',/,1X,
+ 'The average background ratio lies outside the range',
+ ' 0.9 to 1.1',/,1X,'Actual values: minimum:',F6.2,
+ ' maximum:',F6.2,
+ /,1X,'This may be because the GAIN for the scanner is',
+ ' not set correctly.',/,1X,'The true gain is the ',
+ 'input gain multiplied by BGRATIO**2.',/,1X,
+ 'NOTE however that diffuse scatter can lead to an ',
+ 'increased value of BGRATIO',/,1X,'even if the',
+ ' gain is correct.',
+ /,1X,'Since the gain for any scanner should remain ',
+ 'constant, it should be worked out',/,1X,'for a ',
+ 'crystal giving strong diffraction and "clean" ',
+ 'spots (ie no disorder or',/,1X, 'diffuse scatter)',
+ 'and kept at this value.',/,1X,'Processing data with',
+ ' an incorrect gain will result in a systematic ',
+ /,1X,'overestimate of very weak reflections and ',
+ 'incorrect standard deviations.')
6020 FORMAT(/1X,'OVERALL BACKGROUND RATIO (BGRATIO)',/,1X,
+ '==================================',/,1X,
+ 'The average background ratio lies outside the range',
+ ' 0.9 to 1.1',/,1X,'Actual values: minimum:',F6.2,
+ ' maximum:',F6.2,
+ /,1X,'This may be because the Selwyn granularity for',
+ ' the scanner is',
+ ' not set correctly.',/,1X,'The true granularity is ',
+ 'the input granularity multiplied by BGRATIO**2.',/,1X,
+ 'NOTE however that diffuse scatter can lead to an ',
+ 'increased value of BGRATIO even if the granularity ',
+ 'is correct',
+ /,1X,'Since the granularity for any film type should',
+ ' remain ',
+ 'constant, it should be worked out for a ',/,1X,
+ 'crystal giving strong diffraction and "clean" ',
+ 'spots (ie no disorder or diffuse scatter)',/,1X,
+ 'and kept at this value',/,1X,'Processing data with',
+ ' an incorrect granularity will result in a systematic ',
+ /,1X,'overestimate of very weak reflections and ',
+ 'incorrect standard deviations')
6022 FORMAT(/1X,'BACKGROUND PIXEL REJECTION',/,1X,
+ '==========================',/,1X,
+ 'Too many spots (',I4,') have been rejected because ',
+ 'they have less than',I3,/,1X,'background pixels ',
+ 'after rejection (Number set by MINB on REJECTION ',
+ 'keyword)',/,1X,'Background pixels are rejected ',
+ 'either because they are overlapped by',/,1X,'the ',
+ 'peak of a neighbouring spot, or because they',
+ ' deviate by',/,1X,'more than',F4.1,' sigma (BGSIG',
+ ' on BACKGROUND keyword) from the best background',
+ /,1X,'plane')
6024 FORMAT(/1X,'In this case there is a problem with overlap of ',
+ 'neighbouring spots, so follow advice',/,1X,'given',
+ ' above to alleviate the problem')
6026 FORMAT(/1X,'In this case there is no apparent overlap of ',
+ 'neighbouring spots, so the problem',/,1X,'must ',
+ 'be in the plane fitting.')
6028 FORMAT(/1X,'The value of BGRATIO suggest that the GAIN is ',
+ 'not set correctly, which might',/,1X,'be the cause',
+ 'of the problem')
6030 FORMAT(/1X,'The value of BGRATIO suggests the gain is ',
+ 'correctly set, so you may have to change',/,1X,
+ 'BGSIG on the BACKGROUND keyword')
6032 FORMAT(/1X,'BROAD PROFILES',/,1X,
+ '==============',/,1X,
+ 'At least some of the standard profiles have rather',
+ ' long tails',/,1X,'Percentage of peak pixels with ',
+ 'values less than 5% of maximum value is',F6.1,/,1X,
+ 'This may be genuine, but may ',
+ 'also arise if there is significant diffuse',/,1X,
+ 'scatter which is (incorrectly) being included in',
+ ' the Bragg peak.',/,1X,'Check the profiles ',
+ 'carefully and also inspect the images.',/,1X,
+ 'If the optimisation of the measurement boxes is ',
+ 'making the profiles too broad',/,1X,'(eg a ',
+ 'significant number of "0" in the peak regions ',
+ 'of the printed profiles)',/,1X,'then the ',
+ 'effective size ',
+ 'of the spots can be controlled by PROFILE TOLERANCE',
+ /,1X,'keywords.',
+ /,1X,'Try increasing TOLERANCE (current value',F6.3,
+ ') by eg 0.005',
+ ' and see if the',/,1X,'profiles look better. ',
+ '(Increasing TOLERANCE will'
+ ,' decrease spot size).')
6034 FORMAT(/,1X,'TANGENTIAL OFFSET UNSTABLE',/,1X,
+ '==========================',/,1X,
+ 'The tangential',
+ ' offset parameter (TOFF) is varying more than it should.'
+ ,/,1X,'(Maximum variation is',F6.2,'mm)',/,1X,'If there',
+ ' are large changes in both TOFF and ROFF or CCOMEGA, this ',
+ /,1X,'suggests that the refinement is unstable.',
+ /,1X,'In this case, it is best to fix the ',
+ 'TOFF parameter: REFINEMENT FIX TOFF',/,1X,'If known',
+ ' the correct value can be input:eg DISTORTION TOFF 0.17',
+ 'If not known, the mean refined value can be used.',/,1X,
+ 'In such cases ROFF should also be FIXED.')
6035 FORMAT(/,1X,'If this is happening frequently, ADDPART should not'
+ , ' be used')
6036 FORMAT(/,1X,'VARIATION IN EFFECTIVE EXPOSURE TIMES',/,1X,
+ '=====================================',/,1X,
+ 'A total of',I4,' images show more than 5% variation in',
+ ' exposure time between',/,1X,'Successive images (as ',
+ 'judged by the level of the background)',
+ /,1X,'If this variation is genuine, ',
+ 'then the partial addition option is NOT VALID.',
+ /,1X,'Partial addition should be suppressed using ',
+ 'keywords: ADDPART OFF')
6038 FORMAT(/,1X,'The images in question (only the first 19 will be ',
+ 'listed) are:',/,1X,19I6)
6040 FORMAT(/,1X,'The relative exposure times are:',/,1X,19F6.3)
6042 FORMAT(/1X,'**** IMPORTANT ****',/,1X,
+ '=======================',/,1X,
+ 'PIXELS IN CENTRE OF DETECTOR WITH VALUES OF',
+ ' LESS THAN (OR EQUAL TO)',I5,/,1X,
+ '================================',
+ '========================================',/,1X,
+ 'Spots with pixel values less than (or equal to)',I5,' in',
+ ' the measurement box',/,1X,'(in the peak or background)',
+ ' have been found ',
+ 'in the central region of the',/,1X,'detector (within',I4,
+ 'mm of the direct beam position). These pixels are assumed to',
+ /,1X,'be in the inactive area of the detector.',/,1X,
+ '(The pixel value',
+ ' is set with keyword NULLPIX, and assigning a non-zero',
+ ' value',/,1X,'for NULLPIX can be used to reject spots',
+ ' that lie behind the backstop shadow).',/,/,1X,
+ 'If this is happening because the X-ray background is',
+ ' extremely low,',
+ ' then the',/,1X,'program may be incorrectly rejecting some',
+ ' spots.',/,1X,'You should check if this is indeed the case',
+ ' using the "pick" menu option of',/,1X,'the X-window ',
+ 'graphics to inspect the image.',/,1X,
+ 'To avoid rejecting spots, use the keyword BIAS to add a',
+ ' constant to all pixel',/,1X,'values. The adc offset will ',
+ 'also automatically be adjusted, do NOT reset it',/,1X,
+ 'with an ADCOFFSET keyword.',/,1X,
+ 'In addition, reduce RMAX or RSCAN (LIMITS keyword) to ensure',
+ ' that no spots are',/,1X,'predicted which have any part',
+ ' of their measurement box outside the scanned area.',/,1X,
+ 'ALL SPOTS CONTAINING A PIXEL WITH A VALUE LESS THAN OR ',
+ 'EQUAL TO',I5,' WILL',/,1X,'BE REJECTED UNLESS "BIAS" IS SET.')
6044 FORMAT(/1X,'RATHER FEW FULLY RECORDED REFLECTIONS',/,1X,
+ '=====================================',/,1X,
+ 'If there are not many fully recorded reflections ',
+ 'on an image and the',/,1X,'ADDPART option is not ',
+ 'suitable (eg due to ROFF/TOFF variations)',/,1X,
+ 'then there can be problems with the positional ',
+ 'refinement and profile fitting',/,1X,'To ensure ',
+ 'there are enough reflections for positional ',
+ 'refinement you',/,1X,'may have to include partials',
+ /,1X,'REFINEMENT INCLUDE PARTIALS',/,1X,'or overloads'
+ ,/,1X,'REFINEMENT INCLUDE OVERLOADS',/,1X,'or ',
+ 'decrease the minimum allowed number of reflections',
+ /,1X,'REFINEMENT NREF 15 (say)',/,1X,'To get ',
+ 'enough reflections to form the profiles try ',
+ 'accumulating',/,1X,'over a large number of images',
+ ' (BLOCK subkeyword on SERIAL keyword)',/,1X,
+ 'or reduce the number of standard profiles using',
+ ' the PROFILES XLINES/YLINES option:',/,1X,
+ 'PROFILES XLINES 0 90 180 YLINES 0 90 180',/,1X,
+ 'will give 4 standard profiles.',/,1X,'Alternatively',
+ ' actually include partials in the profiles. ',
+ 'Providing several (at least 5',/,1X,'and preferably',
+ ' 10) images are included, the two halves of the ',
+ ' great majority',/,1X,'of reflections will be ',
+ 'included, giving the fully recorded reflection',
+ '. Use',/,1X,'PROFILE PARTIALS',/,1X,'to do this')
6046 FORMAT(/,1X,'NEGATIVE MOSAIC SPREAD OR BEAM DIVERGENCE',/,1X,
+ '=========================================',/,1X,
+ 'The combined mosaic spread and beam divergence has',
+ ' refined to a negative value.',/,1X,'This may be ',
+ 'indicative of large crystal slippage, incorrect',
+ ' oscillation angle',/,1X,'or simply ',
+ 'unstable refinement. (Look at the sds.)',/,1X,
+ 'Inaccurate cell parameters can also result in the ',
+ 'mosaic spread refining to',/,1X,'a negative value.',
+ /,1X,'If you have not already done so, use the ',
+ ' POSTREF SEGMENT option (or "Refine',/,1X,'cell" ',
+ 'menu option) to determine an accurate cell.')
6048 FORMAT(1X,'It may be advisable to refine one beam parameter ',
+ 'rather than 2 (POSTREF BEAM 1)')
6050 FORMAT(1X,'The refined mosaic spread was reset to 0.05.')
6052 FORMAT(1X,'The offending beam divergence (horizontal or ',
+ 'vertical) was reset to 0.05.')
6054 FORMAT(/1X,'TOO MANY BACKGROUND PIXELS REJECTED',/,1X,
+ '===================================',/,1X,
+ 'The average number of background pixels rejected as',
+ ' outliers (more than',F5.1,' sds from',/,1X,
+ 'background plane, controlled by BACKGROUND BGSIG)',
+ 'is more than expected for a',/,1X,'normal ',
+ 'distribution.',/,1X,'This may arise because of ',
+ 'diffuse scatter giving a "halo" around the ',/,1X,
+ 'diffraction spots, or it may be because the GAIN',
+ ' is set too low')
6056 FORMAT(/1X,'INACCURATE CELL PARAMETERS',/,1X,
+ '==========================',/,1X,
+ 'The following cell parameters are not well defined ',
+ 'in the post refinement',/,1X,A,/,1X,
+ 'The largest sd (at any point in the',
+ ' processing) of the cell parameters are:',/,1X,
+ 'a',F5.2,'A, b',F5.2,'A, c',F5.2,'A, alpha',F5.2,
+ ', beta',F5.2,', gamma',F5.2,' (degrees)'/,1X,
+ 'It may be better to refine the cell using a large',
+ ' width (POSTREF WIDTH)',/,1X,'or using the POSTREF',
+ ' SEGMENT option and then fixing the cell parameters',
+ /,1X,'(POSTREF FIX ALL) during the processing run as',
+ ' an unstable cell can lead',/,1X,'to instability in',
+ ' the refinement of crystal orientation.')
6058 FORMAT(/,1X,'MOSAIC SPREAD REFINEMENT',/,1X,
+ '========================',/,1X,
+ 'The refined mosaic spread differs from the input',
+ ' value by more than 10%',/,1X,'(See above for ',
+ 'actual values)',/,1X,'Remember that the',
+ ' refined value is used ONLY if keywords: POSTREF',
+ ' USEBEAM are',/,1X,'included. Underestimating the',
+ ' true mosaic spread will produce systematic',/,1X,
+ 'errors in the integrated intensities while ',
+ 'overestimating it will result in a',/,1X,
+ 'deterioration in the signal to noise for weak ',
+ 'reflections.',/,1X,'You may wish to revise your',
+ ' estimate of the mosaic spread.')
6060 FORMAT(/,1X,'BEAM DIVERGENCE REFINEMENT',/,1X,
+ '========================',/,1X,
+ 'The refined beam divergence differs from the input',
+ ' values by more than 10%',/,1X,'(See above for ',
+ 'actual values)',/,1X,'Remember that the',
+ ' refined values are used ONLY if keywords: POSTREF',
+ ' USEBEAM are included.',/,1X,'Underestimating the',
+ ' true divergence will produce systematic errors',
+ ' in the integrated intensities',/,1X,'while ',
+ 'overestimating it will result in a deterioration',
+ ' in the signal',/,1X,'to noise for weak reflections',
+ /,1X,'You may wish to revise your estimate of the ',
+ 'beam divergences')
6070 FORMAT(/1X,'STANDARD PROFILES SEEM TO EXTEND WELL BEYOND',
+ ' PEAK AREA',/,1X,
+ '============================================',
+ '==========',/,1X,'For ',I3,' of the standard ',
+ 'profiles, there is more than 10% of the total',/,1X,
+ 'counts in the profile outside the peak region.')
6072 FORMAT(1X,'This may well be because the TOLERANCE is too high,',
+ ' current value is',F6.3,/,1X,'values above 0.035',
+ ' are not recommended')
6073 FORMAT(1X,'Try turning off addition of partials over ',
+ 'adjacent images: ADDPART OFF.')
6074 FORMAT(/,1X,'Examine the printout of the standard profiles ',
+ '(in the logfile)',/,1X,'This can be a result of',
+ ' rather noisy profiles (weak data) or ',/,1X,
+ 'poor profile optimisation. As a last resort',/,1X,
+ 'it can be turned off using keywords PROFILE NOOPT.',
+ /,1X,'If this does not help, try',
+ ' turning off the',/,1X,'weighting when forming the',
+ ' standard profiles (PROFILE NOWSUM)',/,1X,
+ 'The following profiles are affected',/,
+ 1X,25I4)
6076 FORMAT(1X,'The fraction of the profile outside the peak for',
+ ' these profile is given below',/,1X,25F4.2)
6080 FORMAT(/,1X,'TOO MANY BACKGROUND PIXELS OVERLAPPED BY ',
+ 'NEIGHBOURING SPOTS',/,1X,
+ '=========================================',
+ '==================',/,1X,'For some of the ',
+ 'standard profiles, more than half the background',
+ ' pixels are',/,1X,'flagged as being overlapped by',
+ ' neighbouring spots (in the worst case,',F6.1,'%',
+ /,1X,' are overlapped).',/,1X,'You should use the ',
+ 'SEPARATION CLOSE keywords, eg SEPARATION 1.0 1.0',
+ ' CLOSE')
6090 FORMAT(/,1X,'PARTIALS INCLUDED IN POSITIONAL REFINEMENT'/,1X,
+ '==========================================',/,1X,
+ 'Because there were rather few fully recorded ',
+ 'reflections in the central region',/,1X,'of image',
+ I5,' partials have been included in positional',
+ ' refinement.',/,1X,'(The minimum number (eg 20) is',
+ ' set by keywords: REFINEMENT NREF 20 )',/,1X,'This',
+ ' is equivalent to including keywords:',/,1X,
+ 'REFINEMENT INCLUDE PARTIALS',F5.2)
6091 FORMAT(/,1X,'It may now be an advantage to',
+ ' also include partials in profile formation.',/,1X,
+ 'This was not done automatically because the first',
+ ' image to be processed DID have',/,1X,'enough ',
+ 'fully recorded reflections, and if partials are to',
+ ' be included',/,1X,'in the profiles this should be '
+ ,'done for all images.',/,1X,'Use keywords PROFILE ',
+ 'PARTIALS to include partials in profile formation',
+ /,1X,'but preferably use a block size of AT LEAST 5',
+ ' images (given on SERIAL keyword)')
6092 FORMAT(/,1X,'PARTIALS INCLUDED IN POSITIONAL REFINEMENT AND ',
+ 'PROFILES'/,1X,
+ '===============================================',
+ '========'/,1X,
+ 'Because there were rather few fully recorded ',
+ 'reflections in the central region',/,1X,'of the ',
+ 'first image, partials have been included both ',
+ 'in the positional',/,1X,'refinement and in profile',
+ ' formation.',/,1X,'(The minimum number (eg 20) is',
+ ' set by keywords: REFINEMENT NREF 20 )',/,1X,'This',
+ ' is equivalent to including keywords:',/,1X,
+ 'REFINEMENT INCLUDE PARTIALS',F5.2,/,1X,
+ 'PROFILE PARTIALS')
6094 FORMAT(/,1X,'RATHER FEW REFLECTIONS IN POSTREFINEMENT',
+ /,1X,'========================================',/,1X,
+ 'There were not many ',
+ 'reflections available to refine the cell parameters.',
+ /,1X,'Consider using more images to refine the cell',
+ ' (POSTREF ADD or POSTREF WIDTH',/,1X,'options).')
6096 FORMAT(/,1X,'LARGE ERROR IN YSCALE PARAMETER',
+ /,1X,'===============================',/,1X,
+ 'YSCALE differs from the default value by a maximum of',
+ F8.4,/,1X,
+ 'YSCALE determines the relative pixel size in the fast',
+ ' changing direction in',/,1X,'the image. For detectors',
+ ' with equal pixel sizes in X and Y it should be unity.',
+ /,1X,'(R-axis detectors are an exception to this).'/,1X,
+ 'Significantly different values of YSCALE usually ',
+ 'indicate errors in cell',/,1X,'parameters which are ',
+ 'being compensated by changing YSCALE. If YSCALE changes',
+ /,1X,'as a function of rotation angle this is almost',
+ ' certainly the reason.',/,1X,'Try getting better cell ',
+ 'parameters using the POSTREF SEGMENT option.',/,1X,
+ 'If the images contain a lot of diffuse scatter, then',
+ ' the range of',/,1X,'partiality of reflections included',
+ ' in post-refinement should be restricted:',/,1X,
+ 'eg POSTREF FRMIN 0.4 FRMAX 0.6',/,1X,'to only use',
+ ' reflection between 0.4 and 0.6 recorded. This can',
+ /,1X,'improve the cell parameters and give YSCAL values',
+ ' closer to the correct value.')
6098 FORMAT(/,1X,'CANNOT PERFORM POST-REFINEMENT',/,1X,
+ '==============================',/,1X,
+ 'On at least some images there are fewer than ',I3,
+ ' partials extending over only',/,1X,'2 images.',
+ 'Post-refinement can ONLY be carried out using ',
+ 'reflections that extend',/,1X,'over 2 images. Thus ',
+ 'if the mosaic spread (plus beam diveregence) is more',
+ ' than',/,1X,'twice the oscillation angle, ',
+ 'post-refinement is not possible.',/,1X,'Either increase',
+ ' the oscillation angle, or integrate the data in blocks',
+ /,1X,' determining a new orientation by autoindexing',
+ ' for each block')
6100 FORMAT(/,1X,'***** IMPORTANT *****',/,1X,'***** IMPORTANT *****',
+ /,1X,'In order to integrate spots with an angular width',
+ ' of',F7.2,' degrees, the',/,1X,'partiality flags in the',
+ ' MTZ file have had to be changed.',/,1X,'It is ',
+ 'ESSENTIAL that the data is scaled with ',
+ 'SCALA version 2.4.1',/,1X,'(dated 5/1/98) or later ',
+ 'versions, or else some reflections will be rejected.'
+ /,1X,'If using earlier versions, you MUST include the',
+ ' keywords:'
+ ,/,1X,'PARTIALS NOCHECK',/,1X,'when running SCALA.')
6102 FORMAT(/,/,1X,'TOO FEW BACKGROUND PIXELS',/,1X,
+ '=========================',/,1X,'With the input or default ',
+ 'values for RECLEVEL and NBGMIN (',I3,
+ ')',/,1X,'it was not possible to recover enough',
+ ' background pixels for a spot',/,1X,'or ',
+ 'standard profile.',/,1X,'To allow the program',
+ ' to proceed, RECLEVEL was reduced to',F4.1,'.',
+ /,1X,'However, you should examine the measurement',
+ ' box and try to allow more',/,1X,'background.',
+ ' REMEMBER that if a RASTER keyword is supplied',
+ ' the overall',/,1X,'dimensions of the box are ',
+ 'NOT increased unless the keywords:',/,1X,'PROFILE',
+ ' NOFIXBOX',/,1X,' are included.',/)
6200 FORMAT(/,/,1X,'*** For information only. ***')
END
SUBROUTINE WINDIO(NULINE)
C =========================
C
C---- To convert a string so that it can be written to an xdl_view
C I/O window.
C At present it is assumed that the length of lines is 80 characters
C
IMPLICIT NONE
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C ..
C .. Scalar Arguments ..
LOGICAL NULINE
C
C ..
C .. Array Arguments ..
C ..
C .. Local Scalars ..
INTEGER I,J,NUM
C ..
C .. Local Arrays ..
C ..
C .. External Functions ..
C ..
C .. External Subroutines ..
EXTERNAL MXDWIO
C ..
C .. Intrinsic Functions ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioosum.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioosum.h
C---- START of include file ioosum.h
C
C .. Scalars in common block /IOOSUM/
INTEGER NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C
C .. Arrays in common block /IOOSUMC/ ..
CHARACTER*133 LINESUM1(MAXPAX),LINESUM2(MAXPAX)
CHARACTER*101 IOLINE(100)
C ..
C .. Common block /IOOSUM/ ..
COMMON /IOOSUM/ NLSUM1,NLSUM2,NSUMSTART1,NSUMSTART2
C ..
C .. Common block /IOOSUMC/ ..
COMMON /IOOSUMC/ LINESUM1,LINESUM2,IOLINE
C&&*&& end_include ../inc/ioosum.f
C ..
C .. Equivalences ..
SAVE
C ..
C .. Data ..
C ..
C
C
C---- Loop over lines of output, writing each one to the I/O window
C
DO 50 I = 1,100
C
C---- Allow for fact that format statement may start with newline
C characters...allow up to 5
C
IF ((IOLINE(I).EQ.' ').AND.(I.GT.5)) THEN
C
C---- Reset all lines to blanks
C
DO 10 J = 1,100
IOLINE(J) = ' '
10 CONTINUE
RETURN
END IF
IF (IOLINE(I).EQ.' ') GOTO 50
IF (IOLINE(I)(1:1).EQ.' ') IOLINE(I)(1:100) = IOLINE(I)(2:101)
NUM = 1
IF (I.LT.100) THEN
IF ((IOLINE(I+1).EQ.' ').AND.(NULINE)) NUM = 3
END IF
CALL MXDWIO(IOLINE(I),NUM)
50 CONTINUE
RETURN
END
C
SUBROUTINE WMTZSP(NHKL,PHI,IHKLSTR)
C ===================================
C
IMPLICIT NONE
C
C---- Stores a reflection in memory for strategy option
C after reducing the indices to the unique part of reciprocal
C space
C
C
C
C
C .. Include files ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C .. Scalar Arguments ..
REAL PHI
C ..
C .. Array Arguments ..
INTEGER NHKL(3)
INTEGER*2 IHKLSTR(MCOLSTR,NREFSTR)
C ..
C .. Local Scalars ..
INTEGER I,KSYM,IPHI
C ..
C .. Local Arrays ..
REAL ADATA(MCOLSTR)
INTEGER JHKL(3)
C ..
C .. External Subroutines ..
EXTERNAL ASUPUT,LWREFL
C ..
C .. Intrinsic Functions ..
INTRINSIC MOD
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/strat.f
C--- awk generated include file strat.h
C---- START of include file strat.h
C
C---- Stores variables for use in STRATEGY option
C IROTAX is the axis closest to the rotation axis
C PHIROTAX is the angle this axis makes with the rotation axis
C
C PHIZONE is the phi value at which axis "IZONEAX" is along the
C X-ray beam. (IZONEAX = 1 is a, =2 is b, =3 is c)
C PHIPAD is the rotation to be added to PHILAUE to ensure generation
C of all unique data, and will depend on angle between the
C unique axis and the rotation axis.
C AUTANOM if true tries to maximise number of anomalous pairs
C CELLSCAL is the scale factor applied to the cell edges to
C speed up the calculation.
C SHRUNK is TRUE if the cell has been scaled by CELLSCAL
C ISTRUN is used to increment input phi angles by multiples of
C 360 degrees, so that phi values in different parts can
C be recognised. It starts at zero.
C FIRSTRAT Starts as TRUE (set in MOSDATA) and is set to FALSE once
C the MTZ file has been opened for a STRATEGY run.
C Reset TRUE after EXITing from STRATGEY prompt.
C
C .. Scalars in common /STRAT/ ..
INTEGER NSEGM,IPCKCUR,NSTRAT,NUNIQ,NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK
LOGICAL STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,FIRSTRAT,
+ NEWSTRAT,WAITINP,OFFPHI
REAL ROTAUTO,PHILAUE,PHIPAD,PHIZONE,PHIROTAX,CELLSCAL
C ..
C .. Arrays in common /STRAT/ ..
REAL PHIST,PHIFIN,PHIINC,PHIADD,PHISEGA
INTEGER IFIRSTONE
C ..
C .. Common Block /STRAT/ ..
COMMON /STRAT/ PHIST(NSEGMAX),PHIFIN(NSEGMAX),PHIINC(NSEGMAX),
+ PHIADD(NSEGMAX),PHISEGA(NSEGMAX),ROTAUTO,PHILAUE,PHIPAD,
$ PHIZONE,PHIROTAX,CELLSCAL,IFIRSTONE(NSEGMAX),
$ NSEGM,IPCKCUR,NSTRAT,NUNIQ,
+ NSTRUN,ISTRUN,NSEGAUTO,
+ IZONEAX,IROTAX,NLAST,NNPACKS,NLASTPACK,
+ STRATEGY,AUTO,SIZESET,AUTANOM,SHRUNK,
+ FIRSTRAT,NEWSTRAT,WAITINP,
+ OFFPHI
C ..
C
C
C&&*&& end_include ../inc/strat.f
C ..
SAVE
C
C
DO 10 I = 1,MCOLSTR
ADATA(I) = 0.0
10 CONTINUE
C
C---- Set batch number to 9999
C
ADATA(4) = 9999.0
IPHI = PHI
ADATA(5) = IPHI
CAL ADATA(7) = FLOAT(IPCKCUR)
C
C---- Reduce to asymmetric unit
C
CALL ASUPUT(NHKL, JHKL, KSYM)
C
ADATA(1) = JHKL(1)
ADATA(2) = JHKL(2)
ADATA(3) = JHKL(3)
C
C---- Set symmetry number
C
ADATA(6) = FLOAT (MOD (KSYM,2) + 1)
C
C ********************
CAL CALL LWREFL(MTZOUT,ADATA)
C ********************
NSTRAT = NSTRAT + 1
C
C---- Check enough room to store this reflection
C
IF (MCOLSTR*NSTRAT.GT.IXWDTH*IYLENGTH) THEN
WRITE(IOUT,FMT=6000) NSTRAT
IF (ONLINE) WRITE(ITOUT,FMT=6000) NSTRAT
STOP
END IF
6000 FORMAT(//,1X,'***** FATAL ERROR *****',/,1X,
+ 'Not enought memory to store all generated reflections',/,1X,
+ 'Either reduce the rotation range or increase parameter ',
+ 'IXWDTH or IYLENGTH',/,1X,'and recompile program')
C
C---- Store this reflection
C
DO 20 I = 1,MCOLSTR
IHKLSTR(I,NSTRAT) = NINT(ADATA(I))
20 CONTINUE
C
C
C
END
C== WPRSETUP ==
SUBROUTINE WPRSETUP(LRAS,WPROFL,WPRSUMS,MASK)
C
C---- This forms the weighted profile from sums determined earlier and
C scales the weighted profile in WPROFL to a maximum of 10,000
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
C ..
C .. Array Arguments ..
INTEGER LRAS(5),MASK(MAXBOX)
REAL WPROFL(MAXBOX),WPRSUMS(MAXBOX)
C ..
C .. Local Scalars ..
REAL PRMAX,WPRIJ
+
INTEGER HX,HY,IJ,P,Q,NXY,NXX,NYY,IOD
C ..
C .. Local Arrays ..
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/pro2.f
C--- awk generated include file pro2.h
C---- START of include file pro2.h
C
C .. Scalars in Common /PRO2/ ..
REAL PRCENSUM
C
C .. Arrays in Common Block /PRO2/ ..
INTEGER IODPROF
C ..
C .. Common Block /PRO2/ ..
COMMON /PRO2/PRCENSUM,IODPROF(MAXBOX)
C ..
C
C
C&&*&& end_include ../inc/pro2.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C
C .. Equivalences ..
C
SAVE
C ..
C
C
NXX = LRAS(1)
NYY = LRAS(2)
NXY = NXX*NYY
HX = NXX/2
HY = NYY/2
IJ = 0
PRMAX = 0.0
C
C
DO 20 P = -HX,HX
C
DO 10 Q = -HY,HY
IJ = IJ + 1
WPRIJ = WPROFL(IJ)/WPRSUMS(IJ)
C
C---- Only consider peak pixels when finding maximum
C
IF ((MASK(IJ).EQ.1).AND.(WPRIJ.GT.PRMAX)) PRMAX = WPRIJ
WPROFL(IJ) = WPRIJ
10 CONTINUE
20 CONTINUE
C
C---- Scale to maximum value of 10000
C
IJ = 0
DO 40 P = -HX,HX
DO 30 Q = -HY,HY
IJ = IJ + 1
WPROFL(IJ) = 10000.0*WPROFL(IJ)/PRMAX
IOD = WPROFL(IJ)
30 CONTINUE
40 CONTINUE
C
RETURN
END
C== WRGEN ==
SUBROUTINE WRGEN(MODE,PROFILE,ADDPART)
C =====================================
C
IMPLICIT NONE
C
C
C---- When using accumulated profiles, the refined camera
C constants must be written back to the generate file
C for each "A" film during the first pass, as this
C information is lost when the next "A" film is refined.
C also, when the intensities of the "A" film are written
C during the second pass, the camera constants must not be
C written back, because they will be the values for the
C last film processed during the first pass
C
C
C if MODE=-1 for nofid option. same as MODE 0, but camera
C constants for B and C films will be written to
C their special locations
C if MODE=0 both camera constants and intensities will be
C written (only used if not accumulating profiles).
C if MODE=1 only camera constants are written
C if MODE=2 only intensities are written
C if MODE=3 write camera constants for "B" or "C" films
C (only used with FINDCC option)
C if MODE.gt.3 write back camera constants for B and C films
C to their own location in header. used with NOFID
C option.
C
C writes out measured intensities to generate file
C sets all unmeasured spots explicitly as unmeasured
C
C
C
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER MODE
LOGICAL PROFILE,ADDPART
C ..
C .. Local Scalars ..
REAL RADEG
INTEGER I,IBNEG,IBPOS,IBULGE,ICOL,ICOLN,IERR,IPNT,IPT,ITILT,
+ ITWIST,IVERT,K,NC,NEXTF,NRX,NRY,NXS,NYS,I4INTP,I4INTS,
+ IIRMG,IIR,IIM,IR1,IR2
LOGICAL BORCASA,MSRD
INTEGER*2 IRMG
BYTE IR,IM
C ..
C .. Local Arrays ..
REAL RBUFF(45)
INTEGER IBUFF(45),IBUFH(180)
INTEGER*2 IBUF(18)
BYTE B(2)
C ..
C .. External Subroutines ..
EXTERNAL QBACK,QREAD,QSEEK,QWRITE
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/extras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file extras.h
C---- START of include file extras.h
C
C
C .. Scalars in common /EXTRAS/ ..
INTEGER JUMPAX,NPACKS
LOGICAL ISKIP,AFILM,BFILM,CFILM,STARTA,STARTB,STARTC
C ..
C .. Common block /EXTRAS/ ..
COMMON /EXTRAS/JUMPAX,NPACKS,ISKIP,AFILM,BFILM,CFILM,STARTA,
+ STARTB,STARTC
C ..
C
C
C&&*&& end_include ../inc/extras.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/rfs.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file rfs.h
C---- START of include file rfs.h
C
C
C
C .. Scalars in common block /RFS/ ..
REAL FDIST,ESTART,RMSRES,WRMSRES,WESTART
INTEGER MAXREF,MAXX,MAXY,NRS,MAXR,NREJS
C ..
C .. Arrays in common block /RFS/ ..
REAL XRS,YRS,WXRS,WYRS
INTEGER RRS,IHKLR
C ..
C .. Common Block /RFS/ ..
COMMON /RFS/XRS(62),YRS(62),WXRS(62),WYRS(62),FDIST,ESTART,
$ RMSRES,WRMSRES,WESTART,RRS(62),IHKLR(3,62),MAXREF,MAXX,
+ MAXY,NRS,MAXR,NREJS
C ..
C
C
C&&*&& end_include ../inc/rfs.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
C---- Temporary common to control flagging of summed partials
C
COMMON /TEMP1/ SUMFLAG
LOGICAL SUMFLAG
C
C .. Equivalences ..
EQUIVALENCE (B(1),IRMG), (B(1),IR), (B(2),IM)
EQUIVALENCE (IRAS(1),NXS), (IRAS(2),NYS), (IRAS(3),NC)
EQUIVALENCE (IRAS(4),NRX), (IRAS(5),NRY)
EQUIVALENCE (IBUFF(1),RBUFF(1))
EQUIVALENCE (I4INTS,IBUF(7)),(I4INTP,IBUF(13))
C ..
SAVE
C
IF (DEBUG(19)) THEN
WRITE (IOUT,FMT=6001) MODE,PROFILE,ADDPART
IF (ONLINE) WRITE (ITOUT,FMT=6001) MODE,PROFILE,ADDPART
6001 FORMAT(1X,'Enter WRGEN',/,1X,'MODE=',I3,' PROFILE ',L1,
+ ' ADDPART ',L1)
END IF
C
BORCASA = .FALSE.
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
C
C---- IPT is pointer for location of camera constants
C
IPT = 7
C
C
IF ((MODE.GE.3) .OR. (MODE.EQ.-1)) THEN
IF (BFILM) IPT = 19
IF (CFILM) IPT = 22
BORCASA = .TRUE.
C
C
IF (MODE.GE.3) THEN
MODE = 1
ELSE
MODE = 0
END IF
END IF
C
C---- If raster box has been updated in chkras when running
C online, or with a raster keyword when running in batch mode
C write it back now to generate file
C
C---- Also, if IMGP data, set dynamic range flag in header (word 74)
C
IF ((NEWRAS.NE.0).OR.(IMGP)) THEN
IF (DEBUG(19)) THEN
WRITE (IOUT,FMT=6000) IRAS
IF (ONLINE) WRITE (ITOUT,FMT=6000) IRAS
END IF
C
C ***************************
CALL QSEEK(IUNIT,1,1,36)
CALL QREAD(IUNIT,IBUFH,720,IERR)
C ***************************
C
IF (NEWRAS.NE.0) THEN
IPNT = 53
C
C
DO 10 I = 1,5
IPNT = IPNT + 1
IBUFH(IPNT) = IRAS(I)
10 CONTINUE
END IF
C
C---- Dynamic range flag, indicates intensities are I*4 and stored
C in I*2 words 7 and * with Sd in word 9 or reflection records
C
IF (IMGP) IBUFH(74) = 1
C
C ***********************
CALL QSEEK(IUNIT,1,1,36)
CALL QWRITE(IUNIT,IBUFH,720)
C ***********************
C
NEWRAS = 0
END IF
C
C---- if this is an a film, write refined film parameters back
C to generate file
C
IF (MODE.NE.2) THEN
C
C
IF (AFILM .OR. BORCASA) THEN
IF (DEBUG(19)) THEN
WRITE (IOUT,FMT=6002) IPACKREC,IPACKHEAD
WRITE (IOUT,FMT=6004) IPACKHEAD
IF (ONLINE) WRITE (ITOUT,FMT=6002) IPACKREC,IPACKHEAD
IF (ONLINE) WRITE (ITOUT,FMT=6004) IPACKHEAD
END IF
C
C ***************************
CALL QSEEK(IUNIT,IPACKHEAD,1,36)
CALL QREAD(IUNIT,IBUFF,180,IERR)
C ***************************
C
IF (VEE) THEN
RADEG = 18000.0/3.14159
IBNEG = VBNEG*XTOFD
IBPOS = VBPOS*XTOFD
ITILT = VTILT*XTOFD*RADEG
ITWIST = VTWIST*XTOFD*RADEG
IVERT = VVERT*XTOFD
ELSE
ITILT = TILT/FDIST
ITWIST = TWIST/FDIST
IF (IMGP) THEN
IBULGE = ROFF*100.0
ELSE
IBULGE = BULGE/FDIST
END IF
END IF
C
C
IBUFF(IPT) = CCX
IBUFF(IPT+1) = CCY
RBUFF(IPT+2) = CCOM
C
C---- Only write XTOFRA for A film, as it is defined to be the value
C appropriate for an A film
C Also CBAR,TILT,TWIST,BULGE,YSCAL will be best defined for the A
C film so do not update them for B and C
C
IF (AFILM) THEN
RBUFF(10) = XTOFRA
IBUFF(11) = CBAR
IBUFF(12) = ITILT
IBUFF(13) = ITWIST
IBUFF(14) = IBULGE
RBUFF(15) = YSCAL
C
C
IF (VEE) THEN
IBUFF(16) = IBNEG
IBUFF(17) = IBPOS
IBUFF(18) = IVERT
END IF
END IF
C
C ***************************
CALL QSEEK(IUNIT,IPACKHEAD,1,36)
CALL QWRITE(IUNIT,IBUFF,180)
C ***************************
C
END IF
END IF
C
C---- NOTE: 5 records in pack header
C
IPACKREC = IPACKHEAD + 5
IF (MODE.EQ.1) THEN
C
C---- Reposition generate file at end of this pack so that
C the next pack can be found in "findpack"
C
IPACKREC = IPACKREC + TOSPT
C
C **************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C **************************
C
IF (DEBUG(19)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6006) IPACKREC
WRITE (IOUT,FMT=6006) IPACKREC
END IF
ELSE
C
C---- Position generate file at start of reflection records
C
C **************************
CALL QSEEK(IUNIT,IPACKREC,1,36)
C **************************
C
IF (DEBUG(19)) THEN
IF (ONLINE) WRITE (ITOUT,FMT=6008) TOSPT,IPACKREC
WRITE (IOUT,FMT=6008) TOSPT,IPACKREC
END IF
C
C---- Loop over reflections, writing out measured intensities
C and setting unmeasured reflections to -9999,-9999
C
IF (AFILM) THEN
ICOL = 7
ELSE IF (BFILM) THEN
ICOL = 9
ELSE
ICOL = 11
END IF
C
C
NEXTF = FILM + 1
C
C
DO 30 I = 1,TOSPT
C
C *************************
CALL QREAD(IUNIT,IBUF,36,IERR)
C *************************
C
C---- Check if this reflection was measured, flag is set in gensort
C
MSRD = (IGFLAG(I).NE.0)
C
C---- For IP data, summation intensities in columns 7 and 8, sd in col 9
C profile intensities in cols 13,14, sd in col 15
C IBUF is Set via equivalences above
IF (IMGP) THEN
I4INTP = -9999
I4INTS = -9999
IBUF(ICOL+2) = -9999
IBUF(ICOL+8) = -9999
ELSE
IBUF(ICOL) = -9999
IBUF(ICOL+1) = -9999
IBUF(ICOL+6) = -9999
IBUF(ICOL+7) = -9999
END IF
C
IR = IRG(I)
IF (IR.GT.IR2) MSRD = .FALSE.
IM = IMG(I)
C
IF (MSRD) THEN
IF (IMGP) THEN
I4INTS = INTG(I)
IBUF(ICOL+2) = ISDG(I)
ELSE
IBUF(ICOL) = INTG(I)
IBUF(ICOL+1) = ISDG(I)
END IF
C
C---- Now profile values if profile fitting used
C
IF (PROFILE) THEN
IF (IMGP) THEN
I4INTP = IPRO(I)
IBUF(ICOL+8) = ISDPRO(I)
ELSE
IBUF(ICOL+6) = IPRO(I)
IBUF(ICOL+7) = ISDPRO(I)
END IF
END IF
C
C---- No longer write the correct IR to output generate file. This means the
C generate file can no longer be used as input to subsequent
C programs.
C
IBUF(4) = 0
END IF
C
C---- Set int,isd for succeeding packs to -9999,-9999 in case
C they have been measured previously
C Don't do this for IP data !!!
IF ((.NOT.CFILM).AND.(.NOT.IMGP)) THEN
C
C
DO 20 K = NEXTF,3
ICOLN = 2*K + 5
IBUF(ICOLN) = -9999
IBUF(ICOLN+1) = -9999
IBUF(ICOLN+6) = -9999
IBUF(ICOLN+7) = -9999
20 CONTINUE
END IF
C
C *********************
CALL QBACK(IUNIT,36)
CALL QWRITE(IUNIT,IBUF,36)
C **********************
C
IF (DEBUG(19) .AND. (I.LT.NDEBUG(19))) THEN
IF (IMGP) THEN
WRITE (IOUT,FMT=6012) I,IGFLAG(I), (IBUF(K),K=1,3),
+ IR,IM,I4INTS,IBUF(9),I4INTP,IBUF(15)
IF (ONLINE) WRITE (ITOUT,FMT=6012) I,IGFLAG(I),
+ (IBUF(K),K=1,3),IR,IM,I4INTS,IBUF(9),I4INTP,IBUF(15)
ELSE
WRITE (IOUT,FMT=6010) I,IGFLAG(I), (IBUF(K),K=1,3),
+ IR,IM,(IBUF(K),K=5,18)
IF (ONLINE) WRITE (ITOUT,FMT=6010) I,IGFLAG(I),
+ (IBUF(K),K=1,3),IR,IM,(IBUF(K),K=5,18)
END IF
END IF
30 CONTINUE
C
IPACKREC = IPACKREC + TOSPT
END IF
C
C---- Format statements
C
6000 FORMAT (/2X,'WRGEN, WRITING BACK NEW RASTER PARAMS',5I4)
6002 FORMAT (/1X,'CURRENT IPACKREC ',I6,' IPACKHEAD',I6)
6004 FORMAT (/1X,'IN WRGEN, WRITING PACK HEADER BACK TO RECORD',I5)
6006 FORMAT (1X,'WRGEN, POSITION GEN FILE AT RECORD ',I6,' FOR NEXT P',
+ 'ACK HEADER')
6008 FORMAT (1X,'WRGEN, WRITING INTENSITIES FOR',I6,' REFLECTIONS STA',
+ 'RTING AT RECORD',I6)
6010 FORMAT (1X,'REFL',I5,' FLAG',I2,' DATA',3I4,2I4,2I7,12I5)
6012 FORMAT (1X,'REFL',I5,' FLAG',I2,' DATA',3I4,2I4,4I7)
C
C
END
C== WRMTZ ==
SUBROUTINE WRMTZ(ISEROP,ADDPART,NEWPREF,ALLOUT,NOLP)
C ===================================================
C
IMPLICIT NONE
C
C---- Write current batch to MTZ file
C
C ALLOUT If TRUE, then all reflections except those outside the
C detector limits are written to the MTZ file.
C
C NOLP IF TRUE, do NOT apply the Lorentz Polarisation corrections
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER ISEROP
LOGICAL ADDPART,NEWPREF,ALLOUT,NOLP
C ..
C .. Local Scalars ..
REAL RADEG,XC,YC,XCAL,YCAL,DSTSQ,SNSQ,CS2TH,FLP,DMAX,DSTCUT
INTEGER I,J,K,ISD,INTPR,ISDPR,NDBG,KSYM,NOUT,IFLAG,NLP,MPART,
+ IR,IM,MP,IOVER,INT,NCUT,IR1,IR2
LOGICAL MSRD,FLAGOUT,BADPROF
C ..
C .. Local Arrays ..
REAL RBATCH(MBLENG),RECMTZ(MCOLS),RMAT(3,3),AHAT(3,3),XHKL(3),
+ HKL(3)
CHARACTER CBATCH(94)*1
INTEGER IH(7),INHKL(3),OUTHKL(3)
C ..
C .. External Functions ..
REAL DOT
EXTERNAL DOT
C ..
C .. External Subroutines ..
EXTERNAL CRYSTHDR,GETHKL,ASUPUT,LPCOR
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/gendata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file gendata.h
C---- START of include file gendata.h
C
C IMG Partiality indicator. 0 for full reflections, 1 to 100
C for partials. Negative for partials at the start of the
C rotation range, +ve for partials at the end of the
C rotation. Set in subroutine REEK using DELEPS calculated
C in subroutine DSTAR
C
C IRG Reflection flag (Set by SPTEST called from DSTAR)
C = 0 Spot can be measured
C = 1 Outside R, X, Y limits
C = 2 Overlapping spot (set later)
C = 3 Too wide in phi (more than NWMAX images)
C = 4 DST .GT. DSTMAX Not included in final film list -
C used only to check for overlaps at edge of film.
C = 10 Spot is within cusp, but will be observed...not included
C in final spot list but must be included in predicted
C pattern
C
C = 21 Spot present on 2 images, this is 1st
C = 22 Spot present on 2 images, this is 2nd
C
C = 31 Spot present on 3 images, this is 1st
C = 32 Spot present on 3 images, this is 2nd
C = 33 Spot present on 3 images, this is 3rd
C
C = 41 Spot present on 4 images, this is 1st
C = 42 Spot present on 4 images, this is 2nd
C = 43 Spot present on 3 images, this is 3rd
C = 44 Spot present on 4 images, this is 4th
C
C etc etc
C
C XG Virtual detector X coordinate in 10 micron units, relative to
C an origin at the direct beam position. X is parallel to the
C Y axis in the laboratory frame, ie orthogonal to the rotation
C axis.
C
C YG Virtual detector Y coordinate in 10 micron units, relative to
C an origin at the direct beam position. Y is parallel to the
C Z axis in the laboratory frame, ie the rotation axis.
C
C IX,IY are the coordinates of the reflection in pixels
C (integers) wrt the first pixel in the image (lower left corner
C cameramans view). For testing for spot overlap, these
C coordinates are in 10 micron units. Also used for display
C pixel coordinates when displaying predicted pattern.
C
C IREC Pointer to the record number of a particular spot in the
C list of generated reflections.
C
C
C ..
C .. Arrays in common /GENDATA/ ..
REAL FRACG,PHIG,PHIWG,XG,YG
INTEGER INTG,IPRO,IX,IY,IREC
INTEGER*2 IRG,IMG,IGFLAG,ISDPRO,ISDG,IHG,IKG,ILG,IMPARTG,
+ MISYMG
C .. Scalars in common /GENDATA/ ..
INTEGER IPACKREC,IPACKHEAD,IRECLAST
C ..
C .. Common block /GENDATA/ ..
COMMON /GENDATA/FRACG(NREFLS),PHIG(NREFLS),PHIWG(NREFLS),
$ XG(NREFLS),YG(NREFLS),INTG(NREFLS),IPRO(NREFLS),
$ IX(NREFLS),IY(NREFLS),IREC(NREFLS),IRG(NREFLS),IMG(NREFLS),
+ IGFLAG(NREFLS),ISDPRO(NREFLS),ISDG(NREFLS),
+ IHG(NREFLS),IKG(NREFLS),ILG(NREFLS),IMPARTG(NREFLS),
+ MISYMG(NREFLS),IPACKREC,IPACKHEAD,IRECLAST
+
C ..
C
C
C&&*&& end_include ../inc/gendata.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/mcs.f
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C
C--- awk generated include file mcs.h
C---- START of include file mcs.h
C
C
C .. Scalars in common block /MCS/ ..
REAL BASEOD,G1OD,CURV
INTEGER FILM,FILMS,CTOFD,PCKIDX,TOSPT,N1OD,XSCMIN,XSCMAX
LOGICAL VEE,VALONGX
C ..
C .. Common block /MCS/ ..
COMMON /MCS/BASEOD,G1OD,CURV,FILM,FILMS,CTOFD,PCKIDX,TOSPT,
$ N1OD,XSCMIN,XSCMAX,VEE,VALONGX
C ..
C CTOFD.... This was the crystal to detector distance (10 micron units)
C but it has now been replaced by XTOFD in common block /XY/
C
C&&*&& end_include ../inc/mcs.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C&&*&& include ../inc/ioomtz.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioomtz.h
C---- START of include file ioomtz.h
C
C
C .. Scalars in common block /IOOMTZ/ ..
INTEGER MTZOUT
LOGICAL MTZOPEN
C ..
C .. Common block /IOOMTZ/ ..
COMMON /IOOMTZ/ MTZOUT,MTZOPEN
C&&*&& end_include ../inc/ioomtz.f
C&&*&& include ../inc/orient.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file orient.h
C---- START of include file orient.h
C Orientation block data
C
C This contains slots for all information that seems to be essential
C at present. Each group of parameters is padded at the end for future
C expansion.
C
C Data in the orientation block are referred to the "Cambridge"
C laboratory axis frame: x along the (idealized) X-ray beam, z along
C usual rotation axis E1 (omega on 3-axis system). The matrix Q converts
C a vector in the Madnes frame to the Cambridge frame. Note that the
C laboratory frame is essentially defined by the vectors e1,e2,e3 &
C source. It doesn't really seem necessary to carry through a whole lot
C of crystal and beam tensors, particularly as we have integrated
C intensities at this stage, but maybe someone will want to, using the
C allocated padding
C
C The general orientation equation is
C
C x = R M U B h
C
C where x position in laboratory frame
C R goniostat matrix
C M missetting angle matrix (if relevant, see MISFLG)
C PhiZ PhiY PhiX (PHIXYZ)
C U crystal orientation matrix UMAT
C B cell orthogonalization matrix, derived from cell dimensions
C h reflection indices
C
C Note that the description below is NOT is the same order as in the
C common block, in which all the integers come before all the reals
C (flagged as I or R in the description below)
C
CI NWORDS number of words in orientation block
CI NINTGR number of integers (first part of block,
C includes these counts)
CI NREALS number of reals
CI IORTYP type of orientation block (for possible future use, now = 0)
CI INTPAD(9) padding for future use (integers)
C
C--- Information for this crystal
C
CR CELLX(6) cell dimensions (A & degrees)
CI LBCELL(6) refinement flags for cell dimensions
CR UMATX(3,3) orientation matrix U. If MISFLG .gt. 0, U is the
C "standard" setting when PhiXYZ ==0
CI MISFLG status of "missetting" angles PHIXYZ
C = 0 PHIXYZ not used, all orientation in UMAT
C = 1 1 set of missetting angles (PHIXYZ(I,1))
C = 2 2 sets PHIXYZ(I,J), J=1,2
CR PHIXYZ(3,2) missetting angles at beginning & end of rotation
CI JUMPAX reciprocal axis closest to principle goniostat axis E1
C (only used for printing)
CI NCRYST crystal number: a crystal may contain several batches
CI LCRFLG type of crystal mosaicity information
C (=0 for isotropic, =1 anisotropic)
C *** CRYDAT(12) equivalenced to following ***
CR ETAD reflection width (full width) (degrees) (if LCRFLG=0)
C or
CR ETADH,ETADV horizontal & vertical reflection width (if LCRFLG=1)
CR rest of CRYDAT: padding for crystal information (eg more complicated
C mosaicity model)
C ***
C
C--- Information for this batch
C
CI LDTYPE type of data
C = 1 oscillation data (2D spots)
C = 2 area detector data (3D spots)
C = 3 Laue data
CR DATUM(3) datum values of goniostat axes, from which Phi is measured
C (degrees)
CR PHISTTX,PHIENDX start & stop values of Phi (degrees) relative to datum
CI JSCAXS goniostat scan axis number (=1,2,3, or =0 for
C multiple axis scan
CR SCANAX(3) rotation axis in laboratory frame (not yet implemented:
C only relevant if JSCAXS=0)
CR TIME1, TIME2 start & stop times in minutes
CI NBSCAL number of batch scales & Bfactors plus SD's
C (4 at present, BSCALE, BBFAC & sd's)
C set = 0 if batch scales unset
CR BSCALE batch scale
CR BBFAC batch temperature factor
C corresponding scale is exp(-2 B (sin theta/lambda)**2)
CR SDBSCL sd (Bscale)
CR SDBFAC sd (BBfac)
CR BATPAD(12) padding for batch information
C
C--- Crystal goniostat information
C
CI NGONAX number of goniostat axes (normally 1 or 3)
CI E1(3),E2(3),E3(3) vectors (in "Cambridge" laboratory frame, see below)
C defining the NGONAX goniostat axes
CC GONLAB(3) names of the three goniostat axes
CR GONPAD(12) padding for goniostat information
C
C--- Beam information
C
CR SOURCE(3) Idealized (ie excluding tilts) source vector
C (antiparallel to beam), in "Cambridge" laboratory frame
CR S0(3) Source vector (antiparallel ! to beam), in
C "Cambridge" laboratory frame, including tilts
CI LBMFLG flag for type of beam information following
C = 0 for ALAMBD, DELAMB only (laboratory source)
C = 1 ALAMBD,DELAMB,DELCORX,DIVHD,DIVVD (synchrotron)
C (other options could include white beam)
C *** BEMDAT(25) equivalenced to following ***
CR ALAMBD Wavelength in Angstroms
CR DELAMB dispersion Deltalambda / lambda.
CR DELCORX Correlated component of wavelength dispersion.
CR DIVHD Horizontal beam divergence in degrees.
CR DIVVD Vertical beam divergence (may be 0.0 for isotropic beam
C divergence.
CR rest of BEMDAT: padding for beam information
C (*** How much here for Laue? ***)
C ***
C
C--- Detector information
C
CI NDET number of detectors (current maximum 2)
C -- for each detector
CR DXn crystal to detector distance (mm)
CR THETAn detector tilt angle (=Madnes:tau2) (degrees)
CR DETLMn(2,2) minimum & maximum values of detector coordinates (pixels)
C (i,j): i = 1 minimum, = 2 maximum
C j = 1 Xdet, = 2 Ydet
C The exact detector frame is not important, but Ydet
C should be the axis ~ parallel to the pricipal
C rotation axis
CR DETPAD(33) padding for detector information
C
C
C ..
C .. Common blocks ..
INTEGER NWORDS,NINTGR,NREALS,IORTYP,LBCELL,MISFLG,
+ JUMPAXX,NCRYST,LCRFLG,LDTYPE,JSCAXS,NBSCAL,NGONAX,LBMFLG,
+ NDET,INTPAD
REAL CELLX,UMATX,PHIXYZ,CRYDAT,DATUM,
+ PHISTTX,PHIENDX,SCANAX,TIME1,TIME2,
+ BSCALE,BBFAC,SDBSCL,SDBFAC,BATPAD,E1,E2,E3,GONPAD,
+ SOURCE,S0,BEMDAT,
+ DX1,THETA1,DETLM1,DX2,THETA2,DETLM2,DETPAD
CHARACTER BTITLE*70, GONLAB*8
C
C---- MTZ orient common blocks
C
C.... (i) Character variables
C
COMMON /CORIEN/ BTITLE, GONLAB(3)
C
C.... (ii) Real/integer variables
C
COMMON /ORIENT/ NWORDS, NINTGR, NREALS,
C
C---- Now the Integer variables
+ IORTYP, LBCELL(6), MISFLG, JUMPAXX, NCRYST, LCRFLG, LDTYPE,
+ JSCAXS, NBSCAL, NGONAX, LBMFLG, NDET, INTPAD(9),
C
C---- Now the Real variables (Batch stuff first)
C
+ CELLX(6), UMATX(3,3), PHIXYZ(3,2), CRYDAT(12), DATUM(3),
+ PHISTTX, PHIENDX, SCANAX(3), TIME1, TIME2,
+ BSCALE, BBFAC, SDBSCL, SDBFAC, BATPAD(12),
C
C---- Now Real variables for goniostat and beam/detector info
C
+ E1(3), E2(3), E3(3), GONPAD(12), SOURCE(3),
+ S0(3), BEMDAT(25), DX1, THETA1, DETLM1(2,2),
+ DX2, THETA2, DETLM2(2,2), DETPAD(33)
C
C&&*&& end_include ../inc/orient.f
C&&*&& include ../inc/reeke.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file reeke.h
C---- START of include file reeke.h
C
C TOR For synchrotron sources, degree of polarisation of the beam
C IMONO Collimation flag for polarisation.
C = 0 Pinhole or mirrors
C = 1 Graphite Monochromator
C = 2 Synchrotron, use TOR
C NWMAX Maximum reflection width in images
C DSTMAX dimensionless rlu, = WAVE/RES where RES is the maximum
C resolution in Angstrom.
C DSTMIN dimensionless rlu, = WAVE/DMAX where DMAX is the maximum
C Bragg spacing
C
C .. Scalars in common block /REEKE/ ..
REAL X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,DSTMAX,DSTPL,DSTPL2,
+ DIVH,DIVV,DELAMB,ETA,DELCOR,DSTMAXS,TOR,DSTMIN,WMAX
INTEGER ISYN,IMONO,NWMAX,IPAD
C ..
C .. logicals in common block /REEKE/ ..
LOGICAL LOGETA,NUREEK
C ..
C .. Arrays in common block /REEKE/ ..
REAL RMC,AMAT
C ..
C .. Common Block /REEKE/ ..
COMMON /REEKE/RMC(3,3),AMAT(3,3),X1,X2,Y1,Y2,Z1,Z2,XYS,DSTAR2,
+ DSTMAX,DSTPL,DSTPL2,DIVH,DIVV,DELAMB,ETA,DELCOR,
+ DSTMAXS,TOR,DSTMIN,WMAX,ISYN,IMONO,NWMAX,IPAD,LOGETA,NUREEK
C ..
C
C
C&&*&& end_include ../inc/reeke.f
C&&*&& include ../inc/reprt.f
C--- awk generated include file reprt.h
C---- START of include file reprt.h
C
C
C
C .. Scalars in common block /REPRT/ ..
REAL AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
+ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT
INTEGER NREF,NOFR,NOLO,MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,
+ NBAD,NBGRJ,NEDGE1,NPARTEND,NSPOVL,NRSYM,NHALF,NSUMPART
LOGICAL PKACCEPT
C ..
C .. Arrays in common block /REPRT/ ..
REAL RATIO,AVSD,AVSDP,AVSIG1,AVSIG2,AVINTI1,AVINTI2,AVPRI1,AVPRI2,
+ RMSDELI1,RMSDELI2,ABSDELI1,ABSDELI2,AVPRSIG1,AVPRSIG2,
+ AVDELSIG1,AVDELSIG2,PKRATIO,RSIGVSM,
+ FIOVSDP,FIOVSDS,PIOVSDP,PIOVSDS,DBIN
INTEGER IRANGE,IANAL,IANALF,NRFLS1,NRFLS2,MEANDELI1,MEANDELI2,
+ NBGRHIST,IVSM,NIVSM,NRESPF,NRESPP,NRESSF,NRESSP,
+ IRESPF,IRESPP,IRESSF,IRESSP,ISDRESPF,ISDRESPP,
+ ISDRESSF,ISDRESSP
C ..
C .. Common Block /REPRT/ ..
COMMON /REPRT/RATIO(10),AVSD(10),AVSDP(10),AVSIG1(10,2),
$ AVSIG2(NMASKS,2),AVINTI1(10,2),AVINTI2(NMASKS,2),
$ AVPRI1(10,2),AVPRI2(NMASKS,2),RMSDELI1(10,2),
+ RMSDELI2(NMASKS,2),ABSDELI1(10,2),ABSDELI2(NMASKS,2),
+ AVPRSIG1(10,2),AVPRSIG2(NMASKS,2),AVDELSIG1(10,2),
+ AVDELSIG2(NMASKS,2),PKRATIO(10),RSIGVSM(13),FIOVSDP(9),
$ FIOVSDS(9),PIOVSDP(9),PIOVSDS(9),DBIN(9),
$ AVBGRATIO,AVSIG,RFULL,RPART,AVPKRATIO,PKRMAXI,BGRMAXI,
$ RFACOV,SDRATOV,SDMON,RESCUT,STHCUT,
$ IRANGE(9),IANAL(10),IANALF(10),NRFLS1(10,2),
+ NRFLS2(NMASKS,2),MEANDELI1(10,2),MEANDELI2(NMASKS,2),
+ NBGRHIST(32),IVSM(13),NIVSM(13),
+ NRESPF(9),NRESPP(9),NRESSF(9),NRESSP(9),
+ IRESPF(9),IRESPP(9),IRESSF(9),IRESSP(9),ISDRESPF(9),
+ ISDRESPP(9),ISDRESSF(9),ISDRESSP(9),NREF,NOFR,NOLO,
$ MAXBSI,MINBSI,NEDGE,NBOX,NBZERO,NNEG,NBAD,
+ NBGRJ,NEDGE1,NPARTEND,NSPOVL,
+ NRSYM,NHALF,NSUMPART,PKACCEPT
C ..
C
C
C&&*&& end_include ../inc/reprt.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
c-harvest
C&&*&& include ../inc/mharvest.f
INTEGER MAXMTZ
PARAMETER (MAXMTZ = 16)
C .. Scalars in common block /CHARVEST/ ..
CHARACTER HVERSION*80,ProjectName*20,DataSetName*20,
+ HBEAMLINE*10,Precipitant*80,
+ PNAME_COLS(MAXMTZ)*20,
+ DNAME_COLS(MAXMTZ)*20
C .. Scalars in common block /IHARVEST/ ..
LOGICAL USECWD,PNAMEgiven,DNAMEgiven,DOHARVEST
REAL PHhar,Hartemp,
+ HARETA(MAXPAX),HARDIV(MAXPAX),HARDIH(MAXPAX)
CHARACTER*3 MKDIRMODE,CHMODMODE
INTEGER KHFLMS
C ..
C .. Common block /CHARVEST/ ..
COMMON /CHARVEST/HVERSION,ProjectName,DataSetName,
+ HBEAMLINE,Precipitant,
+ PNAME_COLS,DNAME_COLS
C .. Common block /IHARVEST/ ..
COMMON /IHARVEST/USECWD,PHhar,Hartemp,KHFLMS,
+ PNAMEgiven,DNAMEgiven,DOHARVEST,
+ HARETA,HARDIV,HARDIH,MKDIRMODE,CHMODMODE
C ..
C&&*&& end_include ../inc/mharvest.f
c-harvest
C ..
C---- Temporary common to control flagging of summed partials
C
COMMON /TEMP1/ SUMFLAG
LOGICAL SUMFLAG
C
C .. Equivalences ..
C ..
C---- Note this equivalence makes array RBATCH map into the common block
C "orient", and CBATCH into the common block "corien" (characters).
C
EQUIVALENCE (NWORDS,RBATCH(1))
EQUIVALENCE (CBATCH(1), BTITLE)
SAVE
C ..
C .. Data statements ..
C
IR1 = 2*IPAD + 1
IR2 = 2*IPAD + 2
IR2 = 30*IPAD + 30
IOVER = 9999
IF (IMGP) IOVER = 999999
NDBG = 0
DSTCUT = 10000.0
NCUT = 0
IF (STHCUT.NE.0.0) THEN
DMAX = SQRT(1.0/STHCUT)
WRITE(IOUT,FMT=6012) DMAX,RESCUT
IF (ONLINE) WRITE(ITOUT,FMT=6012) DMAX,RESCUT
6012 FORMAT(1X,'No data will be written beyond',F6.2,'A ',
+ 'as the mean I/sigma(I) falls below',F6.2)
DSTCUT = (WAVE/DMAX)**2
END IF
IF (DEBUG(50)) THEN
WRITE(IOUT,FMT=6030) ISEROP,ADDPART,TOSPT
IF (ONLINE) WRITE(ITOUT,FMT=6030) ISEROP,ADDPART,TOSPT
6030 FORMAT(1X,'Enter WRMTZ',/,1X,'ISEROP',I6,' ADDPART ',L1,
+ ' Total number of spots',I6)
END IF
C
C---- Set up the matrix PHI*DELPIHZ*DELPHIY*DELPHIX*AMAT used to calculate
C reciprocal lattice coordinates for Lp correction
C
DELPHI(3) = DELPHI(3) + PHIBEG
CALL ROTMAT(DELPHI,RMAT,1)
DELPHI(3) = DELPHI(3) - PHIBEG
CALL MATMUL3(AHAT,RMAT,AMAT)
C
C---- Set up the batch header. This call transfers the information into
C the "orient" common block
C
CALL CRYSTHDR
C
C---- Write the header for batch with serial number ISEROP
C to the MTZ file open for write on index INDEX, batch info
C stored in the two arrays RBATCH (for numbers)
C and CBATCH (for characters).
C If this routine is called at all then it must be called for
C every batch which is to be output - these batch serial numbers
C are stored in array WOMBAT, and are used in LWCLOS.
C If it is called with ISEROP = 0 this is a flag to say that the
C output MTZ file will be a standard file, and not a multi-record
C one, ie no batches. After this call no batch information is
C available to the calling program, so don't call it too soon !
C---- Arguments :
C MTZOUT INTEGER indicates which MTZ file - 1 index
C points to both input and output files
C ISEROP INTEGER serial number of this batch
C if 0 wipe away all batch info for file
C REAL RBATCH(MBLENG)
C RBATCH REAL(*) array from which integer and real batch
C info is decoded by subroutine wbathd
C this should be equivalenced onto the
C appropriate COMMON block in the calling
C program. The first item is nwords,ie how
C many items in the array, if nword is 0
C then only the title is written to header
C CHARACTER*1 CBATCH(CBLENG)
C CBATCH CHARACTER(*)*1 as RBATCH, but for character items - no
C nwords however; title is 1st 70 chars of
C CBATCH.
C
C---- Write out orientation data
C
C ***********************************
CALL LWBAT (MTZOUT,ISEROP,RBATCH,CBATCH)
c-harvest
c
CALL LWBSETID (MTZOUT,ISEROP,ProjectName,DataSetName)
c
C---- Subroutine to write dataset ID for batch BATNO to
C batch headers for multi-record file open on index MINDX
C If LWBAT has been used, the batch headers in RBATW are used,
C else those in RBATR are used.
c
c-harvest
C ***********************************
NOUT = 0
NLP = 0
C
C---- Loop over reflections, writing out measured intensities
C
DO 30 I = 1,TOSPT
BADPROF = .FALSE.
FLAGOUT = .TRUE.
C
C----- Initialise MISYMG, so that in find hkl option we know if
C indices ahave been reduced to au or not.
C
MISYMG(I) = 0
C
C
C---- Check if this reflection was measured, flag is set in PROCESS
C
CAL Change this...now IGFLAG is set to -IBAD which codes the reason
C for rejecting the spot. Those left with -9999 are now off edge of
C detector or overloads, latter are detected by value in INT
C IBAD reason
C 1 BGRATIO too large
C 2 PKRATIO too large
C 4 Negative > 5*sigma
C 8 Gradient too high
C 17 Too many background points rejected
C 32 Overload
C 64 Outside active area, or summed partial with only one half
C
MSRD = (IGFLAG(I).GT.0)
IF (PKACCEPT.AND.(IGFLAG(I).EQ.-2)) THEN
MSRD = .TRUE.
BADPROF = .TRUE.
END IF
IF (ALLOUT) THEN
IR = IRG(I)
MSRD = .TRUE.
IF ((IR.EQ.1).OR.(IR.EQ.4).OR.(IR.EQ.10)) MSRD = .FALSE.
END IF
IF (.NOT.MSRD) GOTO 30
ISD = ISDG(I)
C
C
ISDPR = ISDPRO(I)
INT = INTG(I)
CALL GETHKL(I,IH)
DO 10 J = 1,3
INHKL(J) = IH(J)
HKL(J) = IH(J)
10 CONTINUE
C
C---- Compute rlp coordinates and corrections
C
CALL MATVEC(XHKL,AHAT,HKL)
DSTSQ = DOT(XHKL,XHKL)
IF (DSTSQ.GT.DSTCUT) THEN
NCUT = NCUT + 1
FLAGOUT = .FALSE.
END IF
SNSQ = 0.25*DSTSQ
CS2TH = 1.0 - 2.0*SNSQ
IFLAG = 0
CALL LPCOR(XHKL,CS2TH,FLP,IFLAG)
IF (IFLAG.NE.0) THEN
NLP = NLP + 1
IGFLAG(I) = -2
GOTO 30
END IF
C
C---- Put indices into asymmetric unit
C
C *************************
CALL ASUPUT(INHKL,OUTHKL,KSYM)
C *************************
RECMTZ(1) = FLOAT(OUTHKL(1))
RECMTZ(2) = FLOAT(OUTHKL(2))
RECMTZ(3) = FLOAT(OUTHKL(3))
C
C---- MISYM flag
C
IR = IRG(I)
IM = IMG(I)
IF (ADDPART) THEN
C
C---- With ADDPART option reflections flagged with IR = 21
C are fully recorded, flag here with MPART = 10
C
IF (IR.EQ.0) THEN
MPART = 0
ELSE IF ((IR.EQ.IR1).OR.(NEWPREF.AND.(IR.EQ.IR2))) THEN
MPART = 10
FRACG(I) = 1.0
ELSE
MPART = IR
END IF
ELSE
MPART = IR
END IF
C
MP = 0
C
C---- MP has value 0 for fulls or added partials, 1 for partials
C
IF (MPART.GT.10) MP = 1
RECMTZ(4) = FLOAT(MP*256 + KSYM)
RECMTZ(5) = FLOAT(ISEROP)
IF (NOLP) THEN
RECMTZ(6) = FLOAT(INTG(I))
RECMTZ(7) = MAX(FLOAT(ISD),1.0)
ELSE
RECMTZ(6) = FLP*FLOAT(INTG(I))
RECMTZ(7) = FLP*MAX(FLOAT(ISD),1.0)
END IF
INTPR = IPRO(I)
ISDPR = ISDPRO(I)
C
C---- If poor profile fitted reflections are to be accepted,
C set profile fitted values to those of summation integration.
C
IF (BADPROF) THEN
INTPR = INTG(I)
ISDPR = ISD
BADPROF = .FALSE.
END IF
IF (NOLP) THEN
RECMTZ(8) = FLOAT(INTPR)
RECMTZ(9) = MAX(FLOAT(ISDPR),1.0)
ELSE
RECMTZ(8) = FLP*FLOAT(INTPR)
RECMTZ(9) = FLP*MAX(FLOAT(ISDPR),1.0)
END IF
C
C---- Fraction calc
C
RECMTZ(10) = FRACG(I)
C
C---- Spot coordinates. These are in pixels for CCD,IP, virtual detector mm
C coordinates for film. Really the distinction should be between
C on-line and offline detectors rather than IP and film.
C
IF (IMGP) THEN
XC = XG(I)
YC = YG(I)
CALL MMTOPX(XCAL,YCAL,XC,YC)
C
C---- Convert from 10 micron units to pixels
C
XCAL = 0.01*XCAL/RAST
YCAL = 0.01*YCAL/RAST
C
C---- If image has been stored in memory inverted right to left,
C Correct X coordinate for this.
IF (INVERTX) XCAL = NREC - XCAL + 1
XCAL = MAX(XCAL,1.0)
YCAL = MAX(YCAL,1.0)
RECMTZ(11) = XCAL
RECMTZ(12) = YCAL
ELSE
RECMTZ(11) = 0.01*XG(I)
RECMTZ(12) = 0.01*YG(I)
END IF
C
C---- Phi value
C
RECMTZ(13) = PHIG(I)
RECMTZ(14) = PHIWG(I)
RECMTZ(15) = FLP
RECMTZ(16) = MPART
IF (DEBUG(50).AND.((NDBG.LE.NDEBUG(50)).OR.(MPART.EQ.2)))THEN
NDBG = NDBG + 1
WRITE(IOUT,FMT=6000) I,FLAGOUT,(RECMTZ(K),K=1,MCOLS),IR,IM
IF (ONLINE) WRITE(ITOUT,FMT=6000) I,FLAGOUT,
+ (RECMTZ(K),K=1,MCOLS),IR,IM
6000 FORMAT(1X,'Reflection',I5,' FLAGOUT ',L1,' h,k,l',3F5.0,
+ ' MISYM',F6.0,
+ ' ISEROP',F7.0,' Int,sd',F8.0,F6.0,' Intpr,sd',2F8.0,/,1X,
+ ' Frcalc ',F6.4,' Det X,Y',2F6.0,' Phi',F9.3,' Width',
+ F6.3,' Lp Factor',F9.6,' MPART',F5.0,' IR',I3,' IM',I4 )
END IF
C
C *********************
IF (FLAGOUT) CALL LWREFL(MTZOUT,RECMTZ)
C *********************
IF (FLAGOUT) NOUT = NOUT + 1
C
C---- Now store converted indices, MISYM, and corrected Intensity and sd for
C Rsym analysis on image by image basis.
C
IHG(I) = OUTHKL(1)
IKG(I) = OUTHKL(2)
ILG(I) = OUTHKL(3)
MISYMG(I) = NINT(RECMTZ(4))
IMPARTG(I) = MPART
IPRO(I) = NINT(RECMTZ(8))
ISDPRO(I) = MAX(NINT(RECMTZ(9)),1)
INTG(I) = NINT(RECMTZ(6))
ISDG(I) = MAX(NINT(RECMTZ(7)),1)
30 CONTINUE
C
C
C---- Format statements
C
WRITE(IOUT,FMT=6010) NOUT,ISEROP
IF (ONLINE) WRITE(ITOUT,FMT=6010) NOUT,ISEROP
6010 FORMAT(1X,I6,' Reflections written to MTZ file with batch ',
+ 'number',I8)
C
IF (NLP.NE.0) THEN
WRITE(IOUT,FMT=6020) NLP
IF (ONLINE) WRITE(ITOUT,FMT=6020) NLP
6020 FORMAT(1X,I5,' Reflections rejected because LP correction ',
+ 'could not be calculated')
END IF
IF (NCUT.NE.0) THEN
WRITE(IOUT,FMT=6022) NCUT,DMAX
IF (ONLINE) WRITE(ITOUT,FMT=6022) NCUT,DMAX
6022 FORMAT(1X,I5,' Reflections rejected because they were beyond',
+ ' limiting resolution of',F6.2,'A')
END IF
C
END
SUBROUTINE WSPOT(IFLAG)
IMPLICIT NONE
C
C---- Open file and write an edited spots file (IMSTILLS style)
C IFLAG if non-zero on input, do not ask for new file name
C Returns status flag IFLAG
C IFLAG = 0 OK
C = 1 Failed to write file
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
INTEGER IFLAG
C
C ..
C .. Local Scalars ..
INTEGER I,IXW,IYW,LINELEN,NUMLIN,IBUTTON,IXP,IYP,L,ISTAT,IFAIL,
+ IIMG,IST,IEND,NTOT,NWRIT
CHARACTER LINE*80,STR*100
REAL XX,YY,PHIS,FRAC,FINT,DTOR,XADD,YADD,XC,YC,COMEGAF,SOMEGAF,
+ XF1,YF1,SD
C ..
C .. External Functions ..
INTEGER LENSTR,XDLSTR
EXTERNAL LENSTR,XDLSTR
C ..
C .. External Subroutines ..
EXTERNAL MXDCIO,MXDWIO,XDLF_POPUP_NOTICE,MXDDLG
C ..
C .. Common blocks ..
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
SAVE
C
C---- Defines format of "spots" file from IMSTILLS, which will be
C NEW for version that deals with swung detectors.
C
CAL NEW = .TRUE.
DTOR = ATAN(1.0)*4.0/180.0
NTOT = 0
NWRIT = 0
C
C---- If spots have been found by MOSFLM rather than reading in a file
C need to set up the header variables for the output spots file
C
IF (IFLAG.NE.0) THEN
LIXLEN = NREC
LIYLEN = IYLEN
LPIXEL = RAST
LYSCALE = YSCAL
LOMEGA = OMEGAF/DTOR
INVFLAG = 0
LXCEN = 0.01*XCEN
C
C---- Note that Y beam coordinate, like the spot coordinates, must be
C in true mm, not "pixel mm", and so must be corrected by YSCAL.
C
LYCEN = 0.01*YCEN/YSCAL
IF (INVERTX) THEN
INVFLAG = 1
LXCEN = NREC*RAST - 0.01*XCEN
END IF
C
C---- If old style spots file, need to set up pseudo-fiducial coords
C
XF = 0.0
YF = 0.0
XC = 0.01*XCEN
YC = 0.01*YCEN/YSCAL
C
C----- Note that for the direct beam coordinates we
C need to transform the input XC,YC to the MOSFLM detector frame
C which has X parallel to scanner Y and Y antiparallel to scanner X.
C The coordinates written out are wrt an origin NOT at the direct beam
C position, but at 2*XC,0 in the scanner frame. In REFIX or IDXREF
C an origin shift is applied by subtracting the coordinates of the
C direct beam position (midpoint of fiducials 1 and 3) from all
C spot coordinates.
C
XADD = 0.0
YADD = 0.0
IF (ABS(LOMEGA-90.0).LT.0.1) THEN
YADD = 2*XC
ELSE IF (ABS(LOMEGA-180.0).LT.0.1) THEN
XADD = 2*XC
YADD = 2*YC
ELSE IF (ABS(LOMEGA-270.0).LT.0.1) THEN
XADD = 2*YC
END IF
COMEGAF = COS(OMEGAF)
SOMEGAF = SIN(OMEGAF)
XF1 = XADD + XC*COMEGAF + YC*SOMEGAF
YF1 = YADD - XC*SOMEGAF + YC*COMEGAF
C
XFID1 = XF1
YFID1 = YF1
XFID2 = XF
YFID2 = YF1
XFID3 = XF1
YFID3 = YF1
GOTO 14
END IF
C
IFLAG = 0
IFAIL = 1
IXP = 400
IYP = 400
10 STR = 'Filename ['//SPTNAM(1:LENSTR(SPTNAM))//'] '
CALL MXDDLG(STR, IXP,IYP,NSPTNAM,ISTAT)
IF (ISTAT.EQ.0) NSPTNAM = SPTNAM
C
CALL CCPDPN (ISPOT,NSPTNAM,'UNKNOWN','F',80,IFAIL)
C
C---- Trap file open failure
C
IF (IFAIL.LT.0) THEN
LINE = 'Cannot open output file'
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,XDLSTR(' '),0,
$ XDLSTR('Try again'),9,XDLSTR('Abort'),5,3,0,IBUTTON)
IF (IBUTTON.EQ.1) THEN
GOTO 10
ELSE
IFLAG = 1
RETURN
END IF
END IF
C
C---- Write list of spots.
C
14 DO 40 IIMG = 1,NIMAG
IF ((IFLAG.NE.0).AND.(.NOT.SELECT(IIMG))) GOTO 40
C
C---- Write terminator for previous image
C
IF (NWRIT.GT.0) THEN
XX = -99.
IF (NEWSPT) THEN
WRITE (ISPOT,FMT=6040,ERR=90) XX,XX,XX,XX,XX,XX
ELSE
WRITE (ISPOT,FMT=*,ERR=90) XX,XX,XX,XX,XX
END IF
END IF
C
C---- When writing spots, XCEN,YCEN are always those for the direct beam
C position at the current twotheta irrespective of whether the
C coordinates input with the BEAM keyword were for a swung or
C unswung detector. Thus LISWUNG is always 1
IF (NEWSPT) THEN
LISWUNG = 1
chrp WRITE (ISPOT,FMT=*,ERR=90) LIXLEN,LIYLEN,
chrp + LPIXEL,LYSCALE,LOMEGA,INVFLAG,LISWUNG
chrp WRITE (ISPOT,FMT=*,ERR=90) LXCEN,LYCEN
WRITE (ISPOT,FMT=6060,ERR=90)
$ LIXLEN,LIYLEN,
+ LPIXEL,LYSCALE,LOMEGA,INVFLAG,LISWUNG
WRITE (ISPOT,FMT=6080,ERR=90) LXCEN,LYCEN
6060 FORMAT(2I12,1X,F10.8,1X,2(F11.6,1X),/,2I12)
6080 FORMAT(2F11.5)
ELSE
C
C OLD STYLE OUTPUT
C record 1 ccx,ccy camera constants,
C records 2-4 Pseudo fiducial coordinates
C records 5... spots
C final record terminator
C
WRITE (ISPOT,FMT=*,ERR=90) XF,YF
WRITE (ISPOT,FMT=*,ERR=90) XFID1,YFID1
WRITE (ISPOT,FMT=*,ERR=90) XFID2,YFID2
WRITE (ISPOT,FMT=*,ERR=90) XFID3,YFID3
END IF
C
NWRIT = NWRIT + 1
C
C---- Now the spots themselves
C
C---- Now the spots themselves. In new style spots format the coordinates
C are in mm relative to an origin at the first pixel in the image.
C
C
FRAC = 0.5
C
IST = ISTIMG(IIMG)
IEND = IENDIMG(IIMG)
NSPT = IEND - IST + 1
IF (NSPT.EQ.0) GOTO 38
C
C---- Trap case where an image has been read, but no spots found
C
IF (IENDIMG(IIMG).EQ.0) THEN
NSPT = 0
GOTO 38
END IF
PHIIMG = PHI(IIMG)
DO 30 I = IST,IEND
IF (NEWSPT) THEN
XX = XSPT(I)
YY = YSPT(I)
IF (INVFLAG.EQ.1) XX = LIXLEN*LPIXEL - XX
ELSE
C
C---- test for OMEGAF
C
IF (ABS(OMEGAF/DTOR-0.0).LT.1.0) THEN
XX = XSPT(I)
YY = YSPT(I)
ELSE IF (ABS(OMEGAF/DTOR-90.0).LT.1.0) THEN
XX = YSPT(I)
YY = 2*YFID1 - XSPT(I)
ELSE IF (ABS(OMEGAF/DTOR-180.0).LT.1.0) THEN
XX = 2*XFID1 - XSPT(I)
YY = 2*YFID1 - YSPT(I)
ELSE IF (ABS(OMEGAF/DTOR-270.0).LT.1.0) THEN
XX = 2*XFID1 - YSPT(I)
YY = XSPT(I)
END IF
END IF
FINT = ISPT(I)
SD = ISDSPT(I)
C
C---- Note that XX has been inverted if INVERTX is TRUE and YY has been
C corrected by YSCAL (in PICKSPOTS when stored in YSPT)
C These are therefore in true mm Ccoords wrt an origin at the first
C pixel in image
C
IF (NEWSPT) THEN
WRITE (ISPOT,FMT=6040,ERR=90) XX,YY,FRAC,PHIIMG,FINT,SD
ELSE
WRITE (ISPOT,FMT=*,ERR=90) XX,YY,FRAC,PHIIMG,FINT
END IF
6040 FORMAT(1X,2F10.2,F9.3,F9.3,F12.1,F10.1)
NTOT = NTOT + 1
30 CONTINUE
C
38 WRITE(IOUT,FMT=6020) NSPT,NOIMG(IIMG)
IF(ONLINE) WRITE(ITOUT,FMT=6020) NSPT,NOIMG(IIMG)
40 CONTINUE
6020 FORMAT(1X,I5,' spots written for image',I5)
C
C---- Write final terminator
C
XX = -999.
IF (NEWSPT) THEN
WRITE (ISPOT,FMT=6040,ERR=90) XX,XX,XX,XX,XX,XX
ELSE
WRITE (ISPOT,FMT=*,ERR=90) XX,XX,XX,XX,XX
END IF
C
C---- Add extra line for new format spots file
C
IF (NEWSPT) WRITE (ISPOT,FMT='(1X,2I6,F10.4,I5)') NREC,IYLEN,
+ RAST,INVFLAG
CLOSE(ISPOT)
WRITE(IOUT,FMT=6030) NTOT
IF (ONLINE) WRITE(ITOUT,FMT=6030) NTOT
6030 FORMAT(1X,'A total of',I6,' spots were written to file')
C
RETURN
C
C---- Errors writing spots file
C
90 WRITE(IOUT,FMT=6010)
IF (ONLINE) WRITE(ITOUT,FMT=6010)
6010 FORMAT(1X,'Error writing spots list')
IFLAG = 1
CLOSE(ISPOT)
RETURN
C
END
C== WTRPOF ==
SUBROUTINE WTPROF(OD,LRAS,SOD,A,B,C,WPROFL,WPRSUMS)
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C ..
C .. Scalar Arguments ..
REAL A,B,C,SOD
C ..
C .. Array Arguments ..
INTEGER LRAS(5),OD(MAXBOX)
REAL WPROFL(MAXBOX),WPRSUMS(MAXBOX)
C ..
C .. Local Scalars ..
REAL SCALE,SCALESQ,PA,BKG,WEIGHT
+
INTEGER HX,HY,IJ,IOD,P,Q,NXY,NXX,NYY,IAP,IAQ,NXCEN,NYCEN,
+ HXCEN,HYCEN,IJCEN
C ..
C .. Local Arrays ..
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
C&&*&& include ../inc/debug.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file debug.h
C---- START of include file debug.h
C
C
C
C .. Arrays in common /DEBUG/ ..
REAL XWARN
INTEGER NDEBUG,IWARN
LOGICAL DEBUG,LPRINT,DUMP,WARN
C
C .. Scalars in common /DEBUG/ ..
REAL BGRLIM
INTEGER NDUMP,IDUMP,MXDUMP
LOGICAL SPOT
C
C ..
C .. Common Block /DEBUG/..
COMMON /DEBUG/XWARN(20,100),BGRLIM,NDEBUG(80),IWARN(20,100),
$ NDUMP,IDUMP,MXDUMP,DEBUG(80),LPRINT(20),DUMP(30),
+ WARN(100),SPOT
C ..
C
C&&*&& end_include ../inc/debug.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/pro2.f
C--- awk generated include file pro2.h
C---- START of include file pro2.h
C
C .. Scalars in Common /PRO2/ ..
REAL PRCENSUM
C
C .. Arrays in Common Block /PRO2/ ..
INTEGER IODPROF
C ..
C .. Common Block /PRO2/ ..
COMMON /PRO2/PRCENSUM,IODPROF(MAXBOX)
C ..
C
C
C&&*&& end_include ../inc/pro2.f
C&&*&& include ../inc/ras.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ras.h
C---- START of include file ras.h
C
C
C .. Scalars in common block /RAS/ ..
INTEGER NEWRAS,MINT
C ..
C .. Arrays in common block /RAS/ ..
INTEGER IRAS
REAL VARAS
C ..
C .. Common Block /RAS/ ..
COMMON /RAS/VARAS(5),IRAS(5),NEWRAS,MINT
C ..
C
C
C&&*&& end_include ../inc/ras.f
C
C .. Equivalences ..
C
SAVE
C ..
C
C
NXX = LRAS(1)
NYY = LRAS(2)
NXY = NXX*NYY
C
C---- Dimensions of central box containing central profile. This is
C assumed to be equal to or smaller than any of the standard profile
C boxes in the code below
C
NXCEN = IRAS(1)
NYCEN = IRAS(2)
HX = NXX/2
HY = NYY/2
HXCEN = NXCEN/2
HYCEN = NYCEN/2
C
C----- Get scale factor for scaling standard (central) profile for use
C in weighting. This will be zero if for any reason there is no
C central profile (eg if using NOREF option or if no fully recorded
C reflections in central region) so trap this.
C
IF (PRCENSUM.NE.0.0) THEN
SCALE = SOD/PRCENSUM
ELSE
SCALE = 1.0
END IF
SCALESQ = SCALE*SCALE
C
IJ = 0
IJCEN = 0
C
C
DO 40 P = -HX,HX
C
IAP = ABS(P)
PA = P*A
DO 30 Q = -HY,HY
IAQ = ABS(Q)
IJ = IJ + 1
IOD = OD(IJ)
BKG = PA + Q*B + C
IF ((IAP.LE.HXCEN).AND.(IAQ.LE.HYCEN)) THEN
IJCEN = IJCEN + 1
C
C---- Common region, WEIGHT = background + Scale * Central profile
C
WEIGHT = BKG + SCALE*IODPROF(IJCEN)
ELSE
C
C---- Outside common region, use background only
C
WEIGHT = BKG
END IF
CAL IF (WEIGHT.LE.0.0) THEN
CAL WRITE(6,*),'NEG WT IN WTPROF, WEIGHT,BKG,SCALE*IODPROF',
CAL + WEIGHT,BKG,SCALE*IODPROF(IJCEN)
CAL END IF
IF (WEIGHT.GT.0) THEN
WEIGHT = 1.0/WEIGHT
ELSE
WEIGHT = 0.0
END IF
WPROFL(IJ) = WPROFL(IJ) + WEIGHT*SCALE*(REAL(IOD) - BKG)
WPRSUMS(IJ) = WPRSUMS(IJ) + WEIGHT*SCALESQ
30 CONTINUE
40 CONTINUE
C
RETURN
END
C
C ==============================
SUBROUTINE XCCPHLP(REQUESTNAME)
C ==============================
C
CHARACTER*(*) REQUESTNAME
C
C
CHARACTER*100 HELPFILE
CHARACTER*100 HELPDIR
CHARACTER*4 HELPEXTN
CHARACTER*1 SLASH
CHARACTER*15 LOGNAME
CHARACTER*255 PUTENV_LINE
CHARACTER*255 REQUESTFILE
C
C
REQUESTFILE = REQUESTNAME
C
C *******************
CALL CCPLWC(REQUESTFILE)
C *******************
C
HELPEXTN = '.hlp'
SLASH = '/'
C
C
HELPDIR = ' '
C
C **************************
CALL UGTENV('CCP4_HELPDIR', HELPDIR)
C **************************
C
HELPFILE = HELPDIR (1:LENSTR(HELPDIR)) // SLASH //
+ REQUESTFILE(1:LENSTR(REQUESTFILE)) // HELPEXTN
C
C
ccx WRITE (6,6000) HELPFILE(1:LENSTR(HELPFILE))
6000 FORMAT(' Help file is ',A)
C
C
LOGNAME = 'CHELPFILE'
C
C
PUTENV_LINE = LOGNAME(1:LENSTR(LOGNAME)) // '=' //
+ HELPFILE(1:LENSTR(HELPFILE))
C
C ***************************************************
CALL USTENV ( PUTENV_LINE(1:LENSTR(PUTENV_LINE)), ISTAT)
C ***************************************************
C
ccx WRITE (6,6010) PUTENV_LINE(1:LENSTR(PUTENV_LINE))
6010 FORMAT(' setenv line is ', A)
C
C *****
CALL CHELP
C *****
C
C
RETURN
C
C
END
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C== XDISP ==
SUBROUTINE XDISP(MODE,FIRSTPACK,PACK,IFIRSTPACK,FIRSTFILM,
+ GENOPEN)
C ==========================================================
C
C---- MODE is either returned from MXDSPL or set by calling program
C
C = 0 No special action
C = 1 Do auto-refinement of orientation on returning to main program
C = 2 Display image again after parameter refinement
C = 3 Do auto-refinement and display image after positional refinement
C = 4 Replotting image after positional refinement
C = 5 Repredict pattern before displaying it (used when plotting
C residual vectors over whole image)
C
C PLRESID If TRUE, plot residual vectors
C FIRSTPACK is TRUE if this is the first image in the generate file
C The AUTOMATCH menu option can only be called for the first image
C (as currently implemented)
C
IMPLICIT NONE
EXTERNAL INIKBB,MXDSPL
INTEGER MODE,IFIRSTPACK
LOGICAL PLRESID,FIRSTPACK,PACK,FIRSTFILM,GENOPEN
C&&*&& include ../inc/mxdinc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file mxdinc.h
C---- START of include file mxdinc.h
C
C
c common block for mxd routines: various parameters for XDL routines
c
c base_width width of base frame
c base_height height of base frame
c men_x,men_y position of menu area
c par_x,par_y position of parameter area
C
C IORDER (R) Order of the data in the input image
c with respect to two local axes ax1, ax2 e.g.
c (xf, yf) as a number from 1 to 8.
c 1 +ax1 slow +ax2 fast (+xf, +yf)
c 2 +ax1 slow -ax2 fast (+xf, -yf)
c 3 -ax1 slow +ax2 fast (-xf, +yf)
c 4 -ax1 slow -ax2 fast (-xf, -yf)
c 5 +ax2 slow +ax1 fast (+yf, +xf)
c 6 +ax2 slow -ax1 fast (+yf, -xf)
c 7 -ax2 slow +ax1 fast (-yf, +xf)
c 8 -ax2 slow -ax1 fast (-yf, -xf)
c
c
c JORDER (R) Display order with respect to the two
c local axes (1 to 8) along the X-windows
c axes X horizontal (left to right), Y vertical
c (top to bottom ) with origin at top left
c 1 +ax1 X (horiz) +ax2 Y (vert) (+xf, +yf)
c 2 +ax1 X (horiz) -ax2 Y (vert) (+xf, -yf)
c 3 -ax1 X (horiz) +ax2 Y (vert) (-xf, +yf)
c 4 -ax1 X (horiz) -ax2 Y (vert) (-xf, -yf)
c 5 +ax2 X (horiz) +ax1 Y (vert) (+yf, +xf)
c 6 +ax2 X (horiz) -ax1 Y (vert) (+yf, -xf)
c 7 -ax2 X (horiz) +ax1 Y (vert) (-yf, +xf)
c 8 -ax2 X (horiz) -ax1 Y (vert) (-yf, -xf)
c
c (2 was standard for Laue programs)
c
c nxp_cmp number of pixels compressed to 1 in horizontal
c display direction
c nyp_cmp number of pixels compressed to 1 in vertical
c display direction
c nxdpx number of horizontal pixels in displayed image
c nydpx number of vertical pixels in displayed image
c img_horiz image direction for horizontal display (=1 fast, 2 slow)
c img_vert image direction for vertical display (=1 fast, 2 slow)
c img_map(4) mapping of image to display
c imgmap(1) 1st point on fast axis (Yms)
c imgmap(2) 1st point on slow axis (Zms)
c imgmap(3) increment on fast axis
c imgmap(4) increment on slow
c img_x,img_y x, y position of image
c men_x, men_y x, y position of menu
c par_x, par_y x, y position of parameter table
c io_x, io_y x, y position of IO area
c not_x, not_y x, y position of notice area (parameter table
c with no values)
c pmn_x, pmn_y x, y position of popup abort menu
c ppb_x, ppb_y x, y position of popup progress bar
c busy_x, busy_y x, y position of busy window
c img_width,img_height width, height of image window
c men_width, men_height width, height of menu window
c par_width, par_height width, height of parameter window
c io_width, io_height width, height of IO window
c not_width, not_height width, height of notice area
c pmn_width, pmn_height width, height of Abort menu
c ppb_width width of progress bar
c busy_width, busy_height width, height of busy box
c sub_process .true. if program is sub-process of eg clips, .false.
c if standalone
c
C IFTYPE 1 = unsigned byte data
C 2 = unsigned two-byte data (i2)
C 3 = signed integer data
C 4 = 'squashed i2' data (if Intensity>32767
C store as 65536-Intensity/8)
INTEGER BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP(4),
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2,IFTYPE
INTEGER IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT
LOGICAL SUB_PROCESS, BLANK
C
c DON'T forget to declare function xdlstr as integer
INTEGER XDLSTR
EXTERNAL XDLSTR
c
c ivhbas view object handle for base frame
c ivhimg view object handle for image
c ivhpar view object handle for parameter table
c ivhmen view object handle for menu
c ivhio view object handle for io area
c ivhio2 view object handle for second io area (pick option)
c ivhio3 view object handle for third io area (output)
c ivhnot view object handle for notice area (parameter table)
c ivhpmn view object handle for popup wait menu
c ivhppb view object handle for popup progress bar
c ivhblank view object handle for blank object
c ivhbusy view object handle for busy object
c ivhbusy2 view object handle for second (2 line) busy object
INTEGER IVHBAS, IVHIMG, IVHPAR, IVHMEN, IVHIO, IVHNOT, IVHPMN,
$ IVHPPB, IVHBLANK, IVHBUSY, IVHIO2, IVHBUSY2, IVHIO3
PARAMETER (IVHBAS=1, IVHIMG=2, IVHPAR=3, IVHMEN=4, IVHIO=5,
$ IVHNOT=6, IVHPMN=7, IVHPPB=8, IVHBLANK=9, IVHBUSY=10,
$ IVHIO2=11, IVHBUSY2=12, IVHIO3=13)
c Border boundary between windows
INTEGER BORDER
PARAMETER (BORDER = 4)
c icset colour set number
INTEGER ICSET
PARAMETER (ICSET=1)
c
c iord axis order of image
c = 1 xf slow, yf fast
INTEGER IORD
PARAMETER (IORD = 1)
c
c minw,minh minimum width and height for image display object
INTEGER MINW,MINH
PARAMETER (MINW=0, MINH=0)
c
c ixopix, iyopix pixel origin of displayed part
INTEGER IXOPIX,IYOPIX
PARAMETER (IXOPIX=1, IYOPIX=1)
c
c ibg background menu, =0 for none
INTEGER IBG
PARAMETER (IBG=0)
c
c iovly overlay option
INTEGER IOVLY
PARAMETER (IOVLY=1)
c
c max_pixel maximum number of pixels to use for image display:
c this will be used to control possible compression
c of the image
INTEGER MAX_PIXEL
PARAMETER (MAX_PIXEL = 800)
c Image stuff
c disp_img true if image has been displayed
c
LOGICAL DISP_IMG
c
c ifd file descriptor, = -1 for no file
INTEGER IFD
PARAMETER (IFD=0)
c
c Parameter table stuff
c max_par_col maximum number of parameter columns
c max_par_rows maximum number of parameter rows
c max_par_name maximum length of name
c max_par_str maximum value length
c par_title = -1 no title +1 title present
c par_font font (3=medium)
c par_menu = 1 if popup menus allowed
c disp_par true if parameter table hsa been displayed
c
LOGICAL DISP_PAR
INTEGER MAX_PAR_COL, MAX_PAR_ROWS, MAX_PAR_NAME, MAX_PAR_STR,
$ PAR_TITLE, PAR_FONT, PAR_MENU
PARAMETER (MAX_PAR_COL = 1, MAX_PAR_ROWS = 50,
$ MAX_PAR_NAME = 17, MAX_PAR_STR = 7,
$ PAR_TITLE = 1, PAR_FONT = 2, PAR_MENU = 0)
C
c Menu stuff
c max_men_itms maximum number of menu items
c max_men_name maximum number of characters in menu item
c men_font menu font number (3=medium)
c men_quit_flag = 1 to allow for quit box
c max_men_title maximum length of menu title
c disp_menu true if menu displayed
LOGICAL DISP_MENU
INTEGER MAX_MEN_ITMS, MAX_MEN_NAME, MEN_FONT, MEN_QUIT_FLAG,
$ MAX_MEN_TITLE
PARAMETER (MAX_MEN_ITMS = 19, MAX_MEN_NAME = 19, MEN_FONT = 4,
$ MEN_QUIT_FLAG = 1, MAX_MEN_TITLE = 9)
c
c IO area stuff
c io_font font number
c disp_io true if io area displayed
c disp_io2 true if SECOND io area displayed
c disp_io3 true if THIRD io area displayed
C NSCROLL number of pages to hold for scrolling
LOGICAL DISP_IO,DISP_IO2,DISP_IO3
INTEGER IO_FONT,NSCROLL
PARAMETER (IO_FONT=2)
PARAMETER (NSCROLL=0)
c Notice area stuff (notice area is a parameter table with no values)
c max_not_col maximum number of parameter columns
c max_not_rows maximum number of parameter rows
c max_not_name maximum length of name
c max_not_str maximum value length
c not_title = -1 no title +1 title present
c not_font font (3=medium)
c not_menu = 1 if popup menus allowed
c disp_not true if menu displayed
LOGICAL DISP_NOT
INTEGER MAX_NOT_COL, MAX_NOT_ROWS, MAX_NOT_NAME, MAX_NOT_STR,
$ NOT_TITLE, NOT_FONT, NOT_MENU
PARAMETER (MAX_NOT_COL = 1, MAX_NOT_ROWS = 18,
$ MAX_NOT_NAME = 23,
$ MAX_NOT_STR = 0,
$ NOT_TITLE = +1, NOT_FONT = 2, NOT_MENU = 0)
c
c Menu stuff for Abort menu
c max_pmn_itms maximum number of menu items
c max_pmn_name maximum number of characters in menu item
c pmn_font menu font number (3=medium)
c pmn_quit_flag = 1 to allow for quit box
c max_pmn_title maximum length of menu title
INTEGER MAX_PMN_ITMS, MAX_PMN_NAME, PMN_FONT, PMN_QUIT_FLAG,
$ MAX_PMN_TITLE
PARAMETER (MAX_PMN_ITMS = 0, MAX_PMN_NAME = 12, PMN_FONT = 4,
$ PMN_QUIT_FLAG = 1, MAX_PMN_TITLE = 15)
c Stuff for progress bar
c ppb_font font number (3=medium)
c ppb_colr colour
INTEGER PPB_FONT, PPB_COLR
PARAMETER (PPB_FONT = 4, PPB_COLR=3)
c Busy box
INTEGER BUSY_FONT
PARAMETER (BUSY_FONT = 3)
c
c len_dialog length of dialog box
INTEGER LEN_DIALOG
PARAMETER (LEN_DIALOG = 60)
c
c Overlays
c
c Circles
c cir_ivec vector set number for circles
c cir_colr colour for circles
c cir_iovl overlay number for circles
c cir_symb symbol for centre
INTEGER CIR_IVEC, CIR_COLR, CIR_IOVL, CIR_SYMB
PARAMETER (CIR_IVEC=3, CIR_COLR=6, CIR_IOVL=2, CIR_SYMB=4)
C
C---- Residual vectors
C IRV_VEC Vector set number
C IRV_COL Colour (1 red, 2 yellow, 3 green)
C IRV_OVL Overlay number
INTEGER IRV_VEC, IRV_COL, IRV_OVL
PARAMETER (IRV_VEC=4, IRV_COL=1, IRV_OVL=2)
c Measure
c
c mes_colr colour for measure crosses
INTEGER MES_COLR
PARAMETER (MES_COLR=1)
c Vertical Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER CROSS_IOVL, CROSS_SYMB
PARAMETER (CROSS_IOVL=2, CROSS_SYMB=3)
c Boxes
c box_iovl overlay number for boxes
c box_symb symbol for centre
INTEGER BOX_IOVL, BOX_SYMB, BOX_VEC
PARAMETER (BOX_VEC=2,BOX_IOVL=2, BOX_SYMB=13)
c Circles
c CIRC_iovl overlay number for circles
c CIRC_symb symbol for centre
INTEGER CIRC_IOVL, CIRC_VEC
PARAMETER (CIRC_VEC=5,CIRC_IOVL=2)
c Crosses
c cross_iovl overlay number for circles
c cross_symb symbol for centre
INTEGER XCROSS_IOVL, XCROSS_SYMB
PARAMETER (XCROSS_IOVL=2, XCROSS_SYMB=13)
C
C---- common block last of all
C
COMMON /MXDCMI/ BASE_WIDTH,BASE_HEIGHT,
$ IMAGE_ORDER,JIMAGE_ORDER,NXP_CMP,NYP_CMP,
$ NXDPX,NYDPX,
$ IMG_HORIZ,IMG_VERT,IMG_MAP,
$ IMG_X,IMG_Y,MEN_X,MEN_Y,PAR_X,PAR_Y,IO_X,IO_Y,
$ NOT_X,NOT_Y,PMN_X, PMN_Y,PPB_X, PPB_Y, BUSY_X, BUSY_Y,
$ BUSY_Y2, IFTYPE,
$ IMG_WIDTH, IMG_HEIGHT, MEN_WIDTH, MEN_HEIGHT,
$ PAR_WIDTH, PAR_HEIGHT, IO_WIDTH, IO_HEIGHT,
$ NOT_WIDTH, NOT_HEIGHT, PMN_WIDTH, PMN_HEIGHT,
$ PPB_WIDTH, BUSY_WIDTH, BUSY_HEIGHT,
$ SUB_PROCESS,BLANK,DISP_IMG,DISP_PAR,DISP_MENU,
$ DISP_IO,DISP_IO2,DISP_IO3,DISP_NOT
C&&*&& end_include ../inc/mxdinc.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/gui.f
c gui.h
c maintained by G.Winter
c 16th April 2002
c $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
c
c This defines the variables and common blocks which are used by the
c new gui control routine. This will also be used in xdisp and control,
c to switch the new gui on!
c
c
logical gui_switch
integer nargs
parameter (nargs = 200)
common /gui/ gui_switch
C&&*&& end_include ../inc/gui.f
IF(.NOT.NODISPLAY)THEN
if(gui_switch) then
c if(.true.) then
call neoctrl
else
C
c Initialize keyboard buffer (even if never used)
CALL INIKBB
C
CALL MXDSPL(MODE,FIRSTPACK,PACK,IFIRSTPACK,FIRSTFILM,
+ GENOPEN)
end if
C
ENDIF
RETURN
END
subroutine xfindspots(line)
implicit none
character*400 line
integer status
c new findspotting routine which actually finds the spots and optionally
c writes them to the socket using the write_stuff_to_socket calls.
c started 1st November 2001 - gw
c
c most of this code is a rewrite of the contents of the appropriate
c part of control.f - rewritten to avoid problems with labels etc.
c
c keyword usage
c
c xfindspots threshold $value rmin $value rmax $value ... etc, as
c per the current findspots command. however, could have a lot of typing
c to do, so perhaps the default values which would appear on the GUI
c (find these) should be used if the variable isn't set...
c
c assume for the mo that all of the necessary variables will be in
c common blocks
c the includes... there seem to be only two of these!
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/spots.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C XSPT,YSPT,ISPT store spot coordinates (in mm) and intensity
C
C These arrays hold the complete list of spots found on ALL images.
C Pointers to the first and last spot in each image are kept in arrays
C
C XSPT.... X coordinates (in mm) of spots in total spot list for
C all images.
C
C YSPT.... Y coordinates (in mm) of spots in total spot list for
C all images.
C
C ISPT.... Intensity of spots in total spot list for
C all images.
C
C ISDSPT.. Standard deviations of intensities
C
C INDX... Stores a pointer into arrays XSPT,YSPT,ISPT for the I'th
C displayed spot (only spots above current threshold are
C displayed).
C
C ISTIMG(IMAG)... Pointer to first spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C IENDIMG(IMAG)... Pointer to last spot for image IMAG in arrays
C XSPT,YSPT,ISPT
C
C IXSPT,IYSPT... Spot coordinates in display pixels for current image
C SELECT.... True for images selected for autoindexing
C SPOTFND.... True for images on which spots have been found
C ITHRESH I/sig(I) threshold for spots to be used in autoindexing
C
C .. Scalars in Common Block /SPOTS/ ..
REAL XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,PHIIMG,
+ LPIXEL,LYSCALE,LOMEGA,LXCEN,LYCEN
INTEGER NSPT,ISPOT,ITHRESH,IRSCAL,LIXLEN,LIYLEN,INVFLAG,
+ LISWUNG
CHARACTER*100 SPTNAM,NSPTNAM
C ..
C .. Arrays in common /SPOTS/ ..
REAL XSPT(NSPOTS),YSPT(NSPOTS)
INTEGER ISPT(NSPOTS),IXSPT(NSPOTS),IYSPT(NSPOTS),
+ ISTIMG(MAXIMG),IENDIMG(MAXIMG),ISDSPT(NSPOTS)
INTEGER*2 INDX(NSPOTS)
LOGICAL SELECT(MAXIMG),SPOTFND(MAXIMG)
C ..
C .. Common Block /SPOTS/ ..
COMMON /SPOTS/ XF,YF,XFID1,YFID1,XFID2,YFID2,XFID3,YFID3,
+ XSPT,YSPT,ISPT,IXSPT,IYSPT,INDX,ISPOT,NSPT,
+ ITHRESH,PHIIMG,IRSCAL,LPIXEL,LYSCALE,LOMEGA,
+ LIXLEN,LIYLEN,LXCEN,LYCEN,INVFLAG,LISWUNG,
+ ISTIMG,IENDIMG,SELECT,ISDSPT,SPOTFND
C
COMMON /CSPOTS/ SPTNAM,NSPTNAM
C&&*&& end_include ../inc/spots.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
external getspots, mparse
integer word_index, starts(200), ends(200), lengths(200),
+ types(200), nargs, modesp, id, lprnt, ierr, i, ipx, ipy
character*4 word, chunk
real values(200)
logical boxopen, goflag, printflag
integer*2 spot_posn(10000)
c parse the input line
goflag = .false.
printflag = .false.
modesp = 0
lprnt = 0
boxopen = .false.
call mparse(line, starts, ends, types, values, lengths, nargs)
word_index = 1
do while(word_index .lt. nargs)
word_index = word_index + 1
word = line(starts(word_index):3 + starts(word_index))
call ccplwc(word)
c find the threshold value
if(word .eq. 'thre') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
thresh = values(word_index)
end if
c find the minimum radius for the background box
else if(word .eq. 'rmin') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
rminsp = values(word_index)
end if
c find the maximum radius for the background box
else if(word .eq. 'rmax') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
rmaxsp = values(word_index)
end if
c determine the x and y splitting - this will take two values
else if(word .eq. 'spli') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
xsplit = values(word_index)
end if
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
ysplit = values(word_index)
end if
c the minimum size in x of the spot - mm?
else if(word .eq. 'minx') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
cutwxmin = values(word_index)
end if
c the maximum size in x of the spot - a bit like classifying apples really
else if(word .eq. 'maxx') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
cutwxmax = values(word_index)
end if
c the minimum size in y of the spot - mm?
else if(word .eq. 'miny') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
cutwymin = values(word_index)
end if
c the maximum size in y of the spot
else if(word .eq. 'maxy') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
cutwymax = values(word_index)
end if
c the minimum number of pixels a spot must contain - an integer
else if(word .eq. 'minp') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
npixmin = nint(values(word_index))
end if
c the offset from the axis, for the background box - this will also
c imply an orientation
else if(word .eq. 'xoff') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
xoffset = values(word_index)
radx = .false.
rady = .true.
end if
c likewise the offset, implying an orientation
else if(word .eq. 'yoff') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
yoffset = values(word_index)
radx = .true.
rady = .false.
end if
c an alternate method of specifying the previous two values - as an
c offset and orientation - ie 0 and parallel to the detector axis
else if(word .eq. 'offs') then
word_index = word_index + 1
if(types(word_index) .ne. 2) then
write(*, *) line(starts(word_index):ends(word_index)),
+ ' is not a number'
else
xoffset = values(word_index)
yoffset = values(word_index)
end if
c the orientation of the background determination box - should be
c parallel or perpendicular
else if(word .eq. 'orie') then
word_index = word_index + 1
chunk = line(starts(word_index):3 + starts(word_index))
call ccplwc(chunk)
if(chunk .eq. 'para') then
radx = .true.
rady = .false.
else if(chunk .eq. 'perp') then
radx = .false.
rady = .true.
else
write(*, *) line(starts(word_index):ends(word_index)),
+ ' should be parallel/perpendicular'
end if
else if(word .eq. 'prin') then
printflag = .true.
else if(word(1:2) .eq. 'go') then
c clear the spot list
goflag = .true.
else
write(*, *) line(starts(word_index):ends(word_index)),
+ ' not recognised'
end if
end do
if(goflag) then
do i = 1, maximg
spotfnd(i) = .false.
select(i) = .false.
end do
c here write the background box coordinates to the client - if
c socklo - therefore will need to dig these out!
c now find the spots...
id = idpack(nimag)
call getspots(modesp, id, lprnt, boxopen, ierr)
c catch errors in the getspots routine and write an error message
c either to the standard error or the socket as xml - will need to
c decide on a format for the errors - see control.f at line 11950
c now write them to the socket...
write(*, *) nspt, ' spots found:'
do i = 1, nspt
ipx = nint(xspt(i) / rast)
ipy = nint(yspt(i) * yscal / rast)
if(printflag) write(*, *) ipx, ipy, ispt(i)
spot_posn(2 * i - 1) = ipx
spot_posn(2 * i) = ipy
end do
if(socklo) call write_spots(nspt, serverfd, spot_posn)
end if
return
end
c utility subroutines for ximage
subroutine parsefn(filename, directory, prefix, sep, number,
+ extension, status)
c parsefn
c -------
c subroutine to parse a filename for the relevant parts - this assumes
c a unix-line input of the type:
c
c /home/data/myfile_111.exten
c
c if directory is not present, ' ' will be returned there. if something
c really nasty happens, status will be -ve, else 0
c
c
implicit none
external lenstr
integer lenstr
character*80 filename, directory, prefix
character*8 extension
character*1 sep
integer number, status
logical founddir, foundpref, foundext, foundnum
integer i, j, start, end
status = 0
founddir = .false.
foundpref = .false.
foundext = .false.
foundnum = .false.
c first determine the directory
start = 1
end = lenstr(filename)
print*,filename
i = end
do while(i .gt. 1)
if(filename(i:i) .eq. '/') then
directory = filename(1:i)
founddir = .true.
i = 0
else
i = i - 1
end if
end do
if(.not. founddir) directory = ' '
c next determine sep = either '-' or '_'
sep = ' '
i = end
do while(i .gt. 1)
if((filename(i:i) .eq. '-') .or.
+ (filename(i:i) .eq. '_')) then
sep = filename(i:i)
i = 0
else
i = i - 1
end if
end do
c if sep wasn't found, return an error code
if(sep .eq. ' ') then
status = -1
return
end if
c next determine the prefix of the filename
if(founddir) then
start = lenstr(directory)
end = lenstr(filename)
i = start
do while(i .le. end)
if(filename(i:i) .eq. sep) then
prefix = filename(start:i - 1)
foundpref = .true.
i = end + 1
else
i = i + 1
end if
end do
else
i = 1
do while(i .le. end)
if(filename(i:i) .eq. sep) then
prefix = filename(start:i - 1)
foundpref = .true.
i = end + 1
else
i = i + 1
end if
end do
end if
c if the prefix wasn't found, return an error
if(.not. foundpref) then
status = -2
return
end if
c now determine the extension
end = lenstr(filename)
i = end
do while(i .gt. 1)
if(filename(i:i) .eq. '.') then
extension = filename(i + 1:end)
foundext = .true.
i = 0
else
i = i - 1
end if
end do
if(.not. foundext) then
status = -3
return
end if
c finally separate out the number
c this currently seems to need to know the length of the
c directory - which mightnot exist -> fix
if(founddir) then
start = lenstr(directory)
else
start = 1
end if
end = lenstr(filename)
i = start
j = end
do while(j .gt. start)
if(filename(j:j) .eq. '.') then
end = j - 1
j = start -1
else
j = j - 1
end if
end do
do while(i .lt. end)
if(filename(i:i) .eq. sep) then
start = i + 1
i = end + 1
else
i = i + 1
end if
end do
c scan that little stretch of the filename for the number
read(filename(start:end), *) number
return
end
c =========================================================================
subroutine checkfileexists(filename, directories, ndirs, exists)
implicit none
c checkfileexists
c ---------------
c subroutine to check through a list of directories for a file, returning
c either the index of the directory where the file was found or -1
c
c in the event of the file being in many directories, the first will
c be returned. if exists == 0, file is in cwd
c
integer ndirs
integer exists
external lenstr
integer lenstr
character*80 filename
character*80 directories(10)
integer i, dirlen
logical itsthere
character*80 fullfilename
i = 1
do while(i .le. ndirs)
if(directories(i) .ne. ' ') then
dirlen = lenstr(directories(i))
fullfilename = directories(i)(1:dirlen) // filename
print*,fullfilename
inquire(file = fullfilename, exist = itsthere)
if(itsthere) then
exists = i
return
end if
end if
i = i + 1
end do
fullfilename = './' // filename
inquire(file = fullfilename, exist = itsthere,
+ name = fullfilename)
if(itsthere) then
exists = 0
return
else
exists = -1
return
end if
end
c =========================================================================
subroutine ximage(line)
implicit none
character*400 line
c ximage subroutine - for calling from control.f as a funky
c substitute for the old image keyword - this will actually
c perform the operations, as well as setting values.
c
c ximage load filename
c ximage makejpeg
c ximage makejpeg xmin xmax ymin ymax
c
c or any permutation, for instance ximage load filename makejpeg
c
c the created jpeg will be sent down the socket if such a thing
c is plumbed in
c
c gw november 21st 2001 - this is an interesting date - this is still
c in the future. paradox warning...
c
c gw mod 6th nov 01 - allow for the fact that just the image name
c may be given, sans directory. in this instance, it will have to be
c assumed that the DIRECTORY keyword has been used, so that there is
c something in fdisk, or the appropriate directory is the cwd
c
c gw mod 7th nov 01 - separate out the filename parsing, the checking
c for the existance of files into different subroutines, so that it is
c much clearer what is going on, and the routines may be used in the
c future
c
c gw mod 3rd april 02 - make it so that only the image number is passed
c in in the instance when the template has been set. further, make
c things such that the second thing on the command line is always the
c image identifier
c
c in addition, the command line should be of the form of keyword-value
c pairs
c
c ie
c ximage 301 jpeg on xmin value xmax value ...
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/header.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file header.h
C---- START of include file header.h
C .. Scalars in common block /HEADER/
REAL HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR
INTEGER NHEAD,NTAIL,HNULLPIX
LOGICAL USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,HDRSIZE
C ..
C .. Arrays in common block /HEADER/
INTEGER*4 IHEAD
C ..
C .. Common Block /HEADER/
COMMON /HEADER/ HDIST,HWAVE,HPHIS,HPHIE,HRAST,HTWOTHETA,HTOR,
$ IHEAD(MAXHEAD),NHEAD,NTAIL,HNULLPIX,
+ USEHDR,USETAIL,USEDIST,USEWAVE,USEPHI,
+ HDRSIZE
C ..
C&&*&& end_include ../inc/header.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ccondata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ccondata.h
C---- START of include file ccondata.h
C
C
C .. Scalars in Common /CCONDATA/ ..
CHARACTER GENFILE*200,CCFILE*200,ODEXT*8,WAXFN*134,
+ GTITLE*80,IDENT*40,NEWMATNAM*80,MTZNAM*80,PGNAME*10,
+ SPGNAM*10,ODFILE*200,SEPCHAR*1,SNEWMATNAM*80,
+ TEMPLSTART*100,TEMPLEND*100,TEMPLSAV*100
C ..
C .. Arrays in Common /CCONDATA/ ..
CHARACTER FDISK(10)*80,INLINE(1000)*80
C ..
C .. Common block /CCONDATA/ ..
COMMON /CCONDATA/GENFILE,CCFILE,ODEXT,WAXFN,GTITLE,IDENT,
+ NEWMATNAM,MTZNAM,PGNAME,SPGNAM,ODFILE,
+ SEPCHAR,SNEWMATNAM,TEMPLSTART,TEMPLEND,
$ TEMPLSAV,FDISK,INLINE
C ..
C
C
C&&*&& end_include ../inc/ccondata.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
C&&*&& include ../inc/zoomer.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
integer z_xmin, z_xmax, z_ymin, z_ymax, z_xsize, z_ysize
common /zoomer/ z_xmin, z_xmax, z_ymin, z_ymax, z_xsize,
+ z_ysize
C&&*&& end_include ../inc/zoomer.f
C&&*&& include ../inc/pel.f
C **** This is the IMAGE PLATE version of this common block ****
C
C
C---- START of include file pel.h
C
C
C .. Scalars in common blocks /PEL/ and /PELC/ ..
INTEGER IBA,IPOINT,ISTART
LOGICAL INCORE
C ..
C .. Arrays in common blocks /PEL/ and /PELC/ ..
LOGICAL RDSTRIP
INTEGER*2 BOXOD,IMAGE
C ..
C .. Common Blocks /PEL/ and /PELC/ ..
COMMON /PEL/IBA,IPOINT,INCORE,RDSTRIP(IXWDTH),BOXOD(MAXBOX),
+ ISTART
COMMON /PELC/ IMAGE(IYLENGTH*IXWDTH)
C ..
C
C
C---- END of include file pel.h
C
C&&*&& end_include ../inc/pel.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
c external subroutines
external ccplwc, parsefn, checkfileexists, section
c local variables
character*4 option
character*80 filename, prefix, directory, firstword
character secondword*80, extension*8
character response*1024
integer i, nargs, nfirsti, modeop, temp
integer starts(200), ends(200), types(200), lengths(200)
integer imageno, status, wheresitto, factor, mytheta, myinvert
real values(200), xdiff, xsize
logical pack, forceread, gojpeg, gonewimage, thumbnail
integer tlc(2), brc(2)
external lenstr, mparse, openods
integer lenstr
call mparse(line, starts, ends, types, values, lengths, nargs)
if(nargs .eq. 1) then
write(*, *) line(starts(1):ends(1)), ' requires an argument,',
+ ' try help'
end if
c should have an even number of arguments
if(mod(nargs, 2) .ne. 0) then
c we have an odd number of arguments
write(*, *) line(starts(1):ends(1)),
+ ' requires an even number',
+ ' of arguments'
return
end if
c next, read the image name/number from the command line
if(types(2) .eq. 2) then
c this is a number
imageno = values(2)
if(template) then
call templmake(templstart, templend, ntdig, imageno,
+ filename, status)
write(*, *) 'filename from template = ', filename
else
filename = ident // sepchar // line(starts(2):ends(2)) //
+ extension
end if
else
c this is a filename
filename = line(starts(2):ends(2))
call parsefn(filename, directory, prefix, sepchar, imageno,
+ extension, status)
if(status .lt. 0) then
c something has gone pear shaped
write(*, *) 'Something is wrong with ', filename
return
end if
end if
if(directory .eq. ' ') then
call checkfileexists(filename, fdisk, 10, wheresitto)
if(wheresitto .lt. 0) then
write(*, *) 'Something is wrong with ', filename
return
else
if(wheresitto .eq. 0) then
directory = './'
else
directory = fdisk(wheresitto)
end if
end if
end if
gonewimage = .true.
thumbnail = .false.
c now parse the inputs
c possible command line values
c jpeg on == true == 1, off == false == 0
c xmin number
c xmax number
c ymin number
c ymax number
c zoom number
c xsize number
c ysize number
i = 1
gojpeg = .false.
c new argument parsing stuff
c initialise the limits
z_xsize = 0
z_ysize = 0
z_xmin = 0
z_xmax = 0
z_ymin = 0
z_ymax = 0
do while(i .lt. nargs)
i = i + 2
firstword = line(starts(i):ends(i))
call ccplwc(firstword)
if(firstword .eq. 'jpeg') then
secondword = line(starts(i + 1):ends(i + 1))
if((secondword .eq. 'on') .or.
+ (secondword .eq. 'true') .or.
+ (secondword .eq. '1')) then
gojpeg = .true.
else
gojpeg = .false.
end if
else if(firstword .eq. 'thumbnail') then
secondword = line(starts(i + 1):ends(i + 1))
if((secondword .eq. 'on') .or.
+ (secondword .eq. 'true') .or.
+ (secondword .eq. '1')) then
thumbnail = .true.
else
thumbnail = .false.
end if
else if(firstword .eq. 'xmin') then
if(types(i + 1) .eq. 2) then
z_xmin = values(i + 1)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
else if(firstword .eq. 'xmax') then
if(types(i + 1) .eq. 2) then
z_xmax = values(i + 1)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
else if(firstword .eq. 'ymin') then
if(types(i + 1) .eq. 2) then
z_ymin = values(i + 1)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
else if(firstword .eq. 'ymax') then
if(types(i + 1) .eq. 2) then
z_ymax = values(i + 1)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
else if(firstword .eq. 'xsize') then
if(types(i + 1) .eq. 2) then
z_xsize = values(i + 1)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
else if(firstword .eq. 'ysize') then
if(types(i + 1) .eq. 2) then
z_ysize = values(i + 1)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
else if(firstword .eq. 'quality') then
if(types(i + 1) .eq. 2) then
if((values(i + 1) .gt. 0) .and.
+ (values(i + 1) .lt. 100)) then
temp = values(i + 1)
call jpeg_set_quality(temp)
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer between 0 and 100'
end if
else
write(*, *) line(starts(i + 1):ends(i + 1)),
+ ' should be an integer'
return
end if
end if
end do
c convert to the Mosflm coordinate frame
if(z_xmin .gt. z_xmax) then
temp = z_xmax
z_xmax = z_xmin
z_xmin = temp
else if(z_xmin .eq. z_xmax) then
z_xmin = 0
z_xmax = nrec
end if
if(z_ymin .gt. z_ymax) then
temp = z_ymax
z_ymax = z_ymin
z_ymin = temp
else if(z_ymin .eq. z_ymax) then
z_ymin = 0
z_ymax = iylen
end if
if(z_xmin .lt. 0) z_xmin = 0
if(z_xmax .gt. nrec) z_xmax = nrec
if(z_ymin .lt. 0) z_ymin = 0
if(z_ymax .gt. iylen) z_ymax = iylen
tlc(1) = z_xmin
tlc(2) = z_ymin
brc(1) = z_xmax
brc(2) = z_ymax
if(gonewimage) then
nfirsti = 1
modeop = 1
forceread = .false.
sumpart = .false.
write(*, *) prefix, imageno, extension, directory,
+ templstart, templend
call openods(prefix, imageno, 1, extension,
+ fdisk, modeop, pack, odfile, sepchar,
+ forceread, 1, templstart, templend)
call section
if(ibeam .ne. 2) then
c set a sensible default for the direct beam position - the centre
c of the image
xmm(1) = 0.5 * nrec / rast
xmm(2) = xmm(1)
xmm(3) = xmm(1)
ymm(1) = 0.5 * yscal * iylen / rast
ymm(2) = ymm(1)
ymm(3) = ymm(1)
end if
call xupdate
nimag = nimag + 1
end if
c determine the zoom ratio
xsize = z_xsize
xdiff = z_xmax - z_xmin
if(z_xsize .gt. 0) then
if(z_xsize .gt. (z_xmax - z_xmin)) then
factor = nint(xsize / xdiff)
else
factor = -1 * nint(xdiff / xsize)
end if
else
factor = 1
end if
write(*, *) "FACTOR (FORTRAN) = ", factor
c guess that we should do something clever here to just use the x and
c y sizes as guidelines, so recompute them.
c oh, you don't need to. cool.
c should include the transformation information in this
c document, so that the coordinates can be correctly interpreted
c get the transformation
call gettransform(mytheta, myinvert)
199 format('',
+ 'ok',
+ '', i3, '',
+ i3, '',
+ '', i5, '', i5,
+ '', i5, '', i5,
+ '', i5,
+ '', i5, '', f10.4,
+ '',
$ f10.4, '',
+ '', f10.4, '',
$ '')
298 format('',
+ 'ok',
+ '', i5, '', i5,
+ '', i5, '', i5,
+ '')
299 format('')
c all of these coordinates are in the frame of the DISPLAY
response = ' '
if(thumbnail) then
tlc(1) = 0
tlc(2) = 0
brc(1) = nrec
brc(2) = iylen
write(response, 298) 0, nrec, 0, iylen
call write_socket_section(serverfd, lenstr(response),
+ response)
call write_jpeg(serverfd, nrec, iylen, image,
+ 0, 0, factor, tlc, brc, 0, 0, 0)
response = ' '
write(response, 299)
call write_socket_length(serverfd, lenstr(response),
+ response)
else
write(response, 199) mytheta, myinvert, z_xmin, z_xmax,
+ z_ymin, z_ymax, nrec, iylen, hrast, hphis, hphie - hphis
write(*, 199) mytheta, myinvert, z_xmin, z_xmax, z_ymin,
+ z_ymax, nrec, iylen, hrast, hphis, hphie - hphis
if(socklo) call write_socket_length(serverfd,
+ lenstr(response), response)
if(gojpeg) then
if(socklo) then
c is it perhaps important to consider the size of the resulting image at
c this stage? it might be beneficial to recalculate the limits so that the
c resulting image is something like 800 pixels square
c naaah.
call write_jpeg(serverfd, nrec, iylen, image,
+ 0, 0, factor, tlc, brc, 1, 0, 0)
write(*, *) 'WRITING THE JPEG'
else
write(*, *) 'If you were connecting via sockets',
+ ' you would get a jpeg'
end if
end if
end if
return
end
c =========================================================================
subroutine ximagehelp
c a subroutine to simply write instructions to the screen
c on how to use the ximage keyword - nothing special, but this
c would be most untidy to nail into the middle of a
c subroutine so it has one of it's own
c
c
c
write(*, *) 'ximage help'
write(*, *) '-----------'
write(*, *) 'the ximage keyword can be used to create a jpeg, '
write(*, *) 'set zooming parameters and load an image into RAM'
write(*, *) ' '
write(*, *) 'examples'
write(*, *) 'ximage /my/files/myimage_001.image'
write(*, *) 'ximage /my/files/myimage_001.image jpeg'
write(*, *) 'ximage zoom x0 y0 x1 y1'
write(*, *) 'ximage zoom reset'
write(*, *) 'ximage zoom x0 y0 x1 y1 jpeg'
write(*, *) ' '
write(*, *) '... any almost any other permutation, enjoy'
end
subroutine image2mosflm(in)
implicit none
integer in(2)
integer x, y, quadrant
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
c first convert the coordinates to the centre of the image
c this will depend on the dimensions of the image
quadrant = nint(omegaf / (2 * atan(1.0)))
write(*, *) 'Quadrant = ', quadrant, omegaf
if((quadrant .eq. 1) .or. (quadrant .eq. 3)) then
x = in(1) - iylen / 2
y = in(2) - nrec / 2
else
x = in(1) - nrec / 2
y = in(2) - iylen / 2
end if
if(invertx) then
x = - x
end if
in(1) = cos(omegaf) * x - sin(omegaf) * y
in(2) = sin(omegaf) * x + cos(omegaf) * y
c finally, add back the centre image coordinates
in(1) = in(1) + nrec / 2
in(2) = in(2) + iylen / 2
end
subroutine mosflm2image(in)
implicit none
integer in(2)
integer x, y
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
x = in(1)
y = in(2)
write(*, *) in
if(invertx) then
x = nrec - x
end if
in(1) = cosom0 * x + sinom0 * y
in(2) = - sinom0 * x + cosom0 * y
write(*, *) in
end
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
SUBROUTINE XUPDATE
IMPLICIT NONE
c subroutine to perform updating of the beam position etc
c which would usually be done in control if you're in powder mode
c gw mod 5th november 2001
c
c
c
c
c
c
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C&&*&& include ../inc/condata.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file condata.h
C---- START of include file condata.h
C
C
C FIXSWAP Forces reversal of normal byte-swapping choice.
C
C---- SUMPART True if two images are to be stored in memory at the
C same time. This will be the case if post-refinement
C (other than POSTHOC post-refinement for off-line
C scanners) is being performed. Note that SUMPART is NOT
C used to determine if partials should be added across
C images (this is ADDPART)
C
C---- NEWPREF True if allowing partials over multiple images in post-
C refinement.
C
C---- ADDPART True if partials are to be summed across images. This is
C only appropriate for fixed origin (ie on-line)
C scanners where the X-ray dose is identical for
C each image.
C Direct beam coordinates
C These are read into XMM(3), YMM(3) where (3) is for A,B,C packs
C Immediately on reading in, these values are transferred
C into XCENMM, YCENMM, XCENMMIN(J,3) where J=1->MAXPAX.
C
C If an IMAGE keyword has been given, XCENMM(1,1)=XMM(1) and
C YCENMM(1)=YSCAL*YMM(1). If swung out, YCENMM(1,1) is updated.
C If a BEAM keyword has not been given, XMM,YMM, XCENMM,YCENMM,
C XCENMMIN are all set to the middle of the image.
C Then, when reflecting input to logfile, it AGAIN sets up
C XCENMM,YCENMM for all images using XMM,YMM, this time
C using YSCAL to set up YCENMM, and updating YCENMM if the
C detctor is swung out. (label 708), DO loop 710. If image
C is "inverted", corrects XCENMM for all images.
C XCEN,YCEN are set in "mosflm" to XCENF, YCENF plus
C camera constants, and XCENF,YCENF are in turn set from
C XCENMM,YCENMM. Thus XCENMM,YCENMM are what is actually
C used to define the beam position.
C HBEAMX and HBEAMY are direct beam coordinates as found in
C an image header (e.g. JUPITER CCD)
C
C LPREF If TRUE, return to display after refinement over entire
C image. Only active when integrating interactively. Set by
C toggle button in Parameter window.
C
C LOVERLAP If TRUE, do not call the OVERLAP subroutine
C ALLOUT If TRUE, all reflections (whether measured or not, or
C classified as BADSPOTS or not, will be written to the
C output MTZ file.
C
C NTDIG Number of digits in image number, returned as zero if
C there is an error in the template. Only used if TEMPLATE
C keyword given.
C
C TEMPLATE is TRUE if a TEMPLATE keyword has been given.
C
C NOLP If TRUE, do NOT apply the Lorentz Polarisation corrections
C
C MULTIMTZ True if writing each "block" of images to a separate MTZ file
C
C DISPMENU True if the run was started with a IMAGE keyword. Not to be
C confused with WINOPEN which is true if the X-window display
C is being used, but this is not necessarily starting with
C a "IMAGE" keyword.
C ..
C .. Arrays in common /CONDATA/ ..
REAL XCENMM,YCENMM,THFOIL,PHIBEGA,PHIENDA,RSYM,XMM,YMM,
+ XCENMMIN,YCENMMIN
REAL RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY
C ..
C .. Arrays in common /CONDATA/ ..
INTEGER IDPACK,NFPACK,NFIRST,ICASSET
INTEGER IPACK1A,IPACK2A,ISERAR
LOGICAL AVPROF,FILMPLOT,FORCEB,FORCEC
C
C .. Scalars in common /CONDATA/ ..
C ..
INTEGER NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG
INTEGER IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI
LOGICAL FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C ..
C real arrays, then scalars, integer arrays, scalars, logicals
COMMON /CONDATA/
$ XCENMM(MAXPAX,3),
+ YCENMM(MAXPAX,3), THFOIL(3),PHIBEGA(MAXPAX),
$ PHIENDA(MAXPAX),RSYM(4,4,96),XMM(3),YMM(3),
$ XCENMMIN(MAXPAX),YCENMMIN(MAXPAX),
$ RMSLIM,WRMSLIM,VLIM,XMID,SEP,THICK,PTMIN,REFREJ,WAIT,
+ PHIRNG,YSCALIN,FULLFRAC,WTIME,HBEAMX,HBEAMY,
$ IDPACK(MAXPAX),NFPACK(MAXPAX),NFIRST(MAXPAX),
+ ICASSET(MAXPAX),IPACK1A(50),
+ IPACK2A(50),ISERAR(50),
$ AVPROF(MAXPAX),FILMPLOT(MAXPAX),FORCEB(MAXPAX),
+ FORCEC(MAXPAX),
$ NPACK,NCYC,MAXNX,MAXNY,ITHRESHF,NSIG,IRFMIN,
+ IRFINC,IXSHIFT,IYSHIFT,LIMIT,NBLOCK,INOGEN,NFGEN,MINREF,
+ ISERADD,NSEG,NSYM,NSYMP,NRUN,NSERTOT,IWAVE,ISWUNG,
$ IMAT,ICELL,IUMAT,LSYMM,IDIST,IBEAM,ISCAN,NLINE,NRLINE,
+ NTLINE,ISTARTP,IRAST,INEWMAT,ISEP,NSAVELINE,IPTIME,
+ ISTRT,IANGLE,IBACKS,IPOLAR,IDIVH,IDIVV,IGAIN,IBLOCK,
+ IHKLOUT,IGENF,INRES,NTDIG,DELAY,IMULTI,
$ FINDCC,READCC,NOFID,INTERPOL,CONVOL,NOMEAS,
+ USEPAR,USEOVR,SUMPART,USEBOX,POSTREF,ADDPART,
+ FIXED,POWDER,RWEIGHT,NOREF,MULTISEG,FIXSWAP,POSTHOC,
+ LPREF,LPINTG,DISPMENU,PRMODE,PRCELL,TEMPLATE,
+ LOVERLAP,ALLOUT,NOLP,NEWPREF,NOBACK,MOSEST,MOSES2,
$ HARVESTREADY,HEADINFO,MULTIMTZ
C&&*&& end_include ../inc/condata.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C&&*&& include ../inc/fid.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file fid.h
C---- START of include file fid.h
C
C XCENF,YCENF Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame).
C For IP data this comes from the defined
C direct beam coordinates, for film data it is the
C midpoint of fiducials 1 and 3.
C
C CCX,CCY The difference (in 10 micron units) between the
C refined position of the direct beam (XCEN,YCEN) and
C the ideal direct beam coordinates (XCENF,YCENF),
C in the SCANNER coordinate frame.
C CCX,CCY are updated in RDIST. They are in "pixels"
C rather than mm (but expressed in 10micron units).
C
C DTOFD The distance (in 10 micron units) from the crystal
C to the detector along a normal to the detector.
C For flat, unswung detectors, or swung on a 2 theta arm,
C this is the same as CTOFD and XTOFD. It differs for
C Vee shaped cassettes. Assigned in START and never changed.
C Only actually used in RMAXR for calculating box sizes.
C
C .. Arrays in common /FID/ ..
REAL CCOMABC
INTEGER FSPOS,CCXABC,CCYABC
C ..
C .. Scalars in common /FID/ ..
REAL OMEGAF,CCOM,DTOFD,XCENF,YCENF
INTEGER MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C .. Common block /FID/ ..
COMMON /FID/CCOMABC(3),OMEGAF,CCOM,DTOFD,XCENF,YCENF,FSPOS(4,2),
+ CCXABC(3),CCYABC(3),MM,MMDB,NFID,CCX,CCY,IYOFF
C ..
C
C
C&&*&& end_include ../inc/fid.f
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/test.f
C--- awk generated include file test.h
C---- START of include file test.h
C
C Detector limits, used in SPTEST. All are in 10 micron units.
C In the virtual detector frame, Y is parallel to the rotation axis
C and X is orthogonal to the rotation axis.
C
C In the scanner frame, X is parallel to the slow direction in the
C image, Y is the fast direction.
C
C RSCANSQ Radius**2 of the scanned region of the plate (Mar scanners)
C This is different to the other limits because it is
C applied to the actual scanner coordinates rather than
C the virtual detector coordinates. All other limits apply
C to virtual detector coordinates.
C XSCAN Maximum X coordinate in detector frame (10 micron units)
C YSCAN Maximum Y coordinate in detector frame (10 micron units)
C RSCANX,RSCANY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RSCAN defining the
C useable area of the detector.
C RMINX,RMINY If non-zero, these are the coordinates (10 micron units)
C for the centre of the circle radius RMIN defining the
C useable area of the detector.
C RMXSQD Maximum radius (squared) in virtual detector frame
C RMNSQD Minimum radius (squared) in virtual detector frame
C XMIN Minimum X coordinate in detector frame
C XMAX Maximum X coordinate in detector frame
C YMIN Minimum Y coordinate in detector frame
C YMAX Maximum Y coordinate in detector frame
C
C .. Scalars in common block /TEST/ ..
REAL RMXSQD,RMNSQD,XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,RSCANY,
+ RMINX,RMINY,XSCAN,YSCAN
INTEGER NEXCL,NXYEXC
C
C .. Arrays in common block /TEST/
REAL RESEXL,RESEXH,XYEXC
C ..
C .. Common Block /TEST/ ..
COMMON /TEST/RESEXL(10),RESEXH(10),XYEXC(4,10),RMXSQD,RMNSQD,
$ XMIN,XMAX,YMIN,YMAX,RSCANSQ,RSCANX,
+ RSCANY,RMINX,RMINY,XSCAN,YSCAN,NEXCL,NXYEXC
C ..
C
C
C&&*&& end_include ../inc/test.f
C&&*&& include ../inc/spots2.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file spots.h
C---- START of include file spots.h
C
C---- These stores variables associated with spot-finding routines.
C Note that the final coordinates are kept in XSPT,YSPT in /SPOTS/
C
C XSPOT... X coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C YSPOT... Y coordinates (in mm) of all spots found on current
C image, before rejections based on spot size
C INSPOT... Intensities of all spots found on current
C image, before rejections based on spot size
C ISIGSP... Standard deviations of intensities
C NOIMG The pack or image number.
C PHI.. Phi value of the mid-point of the image
C NIMAG Total number of images read in (for autoindexing)
C NEWSPT If TRUE, new format spot coordinate file, otherwise old
C format.
C MEDWXSPOT Median spot size in pixels in X determined in PICKSPOTS
C MEDWYSPOT Median spot size in pixels in Y determined in PICKSPOTS
C IRSTRT Number of the image on which to restart after an abort
C
C SPXMIN Minimum X coord (relative to direct beam position) for
C spots
C SPYMIN Minimum Y coord (relative to direct beam position) for
C spots
C NSPTD Number of displayed spots
C THRESH Threshold for pixel to be considered part of a spot,
C is (background + THRESH*sigma)
C
C .. Scalars in Common Block /SPOTS2/ and /SPOTS2C/ ..
REAL CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,CUTWYMIN,
+ XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX
INTEGER NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD
LOGICAL RADX,RADY,NEWSPT,DOFIND,FOUND
CHARACTER IMGTEMPL*100,IMGFN*100,IMGNUM*6
C ..
C .. Arrays in common /SPOTS2/ and /SPOTS2C/ ....
INTEGER NPIX,IWXSPOT,IWYSPOT,IORDER,INSPOT,NOIMG,ISDSPOT
REAL BGOD,PHI,XSPOT,YSPOT,RSPOT,PHISTIM
C ..
C .. Common Block /SPOTS2/ and /SPOTS2C/ ....
c COMMON /SPOTS2/XSPLIT,YSPLIT,NBINR,NBINT,
c + IBINLIM,PHI(MAXIMG),NPIXMIN,NPIXMAX,CUTPIXMIN,CUTPIXMAX,
c + CUTWXMIN,CUTWXMAX,CUTWYMIN,CUTWYMAX,
c + BGOD(IXWDTH),YOFFSET,XOFFSET,RADX,RADY,THRESH,IIMAG,NIMAG,
c + NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
c + IORDER(MXSPOT),INSPOT(MXSPOT),XSPOT(MXSPOT),
c + YSPOT(MXSPOT),RSPOT(MXSPOT),RMINSP,RMAXSP,NOIMG(MAXIMG),
c + NEWSPT,DOFIND,ISDSPOT(MXSPOT),MEDWXSPOT,MEDWYSPOT,
c + PHISTIM(MAXIMG),RMINSRCH,RMAXSRCH,NSEARCH,SCALSRCH,
c + ITHSET,ISAFE,IRSTRT,SPXMIN,SPYMIN,THRESHMIN,THRESHMAX,
c + NSPTD
common /spots2/CUTPIXMAX,CUTPIXMIN,CUTWXMAX,CUTWXMIN,CUTWYMAX,
+ CUTWYMIN,XSPLIT,YSPLIT,YOFFSET,XOFFSET,THRESH,RMINSP,RMAXSP,
+ RMINSRCH,RMAXSRCH,SCALSRCH,SPXMIN,SPYMIN,THRESHMIN,
+ THRESHMAX,NBINR,NBINT,IBINLIM,NPIXMIN,NPIXMAX,IIMAG,NIMAG,
+ MEDWXSPOT,MEDWYSPOT,NSEARCH,ITHSET,ISAFE,IRSTRT,
+ NSPTD,RADX,RADY,NEWSPT,DOFIND,FOUND,
$ NPIX(MXSPOT),IWXSPOT(MXSPOT),IWYSPOT(MXSPOT),
$ IORDER(MXSPOT),INSPOT(MXSPOT),NOIMG(MAXIMG),ISDSPOT(MXSPOT),
$ BGOD(IXWDTH),PHI(MAXIMG),XSPOT(MXSPOT),YSPOT(MXSPOT),
$ RSPOT(MXSPOT),PHISTIM(MAXIMG)
COMMON /SPOTS2C/ IMGTEMPL,IMGFN,IMGNUM
C&&*&& end_include ../inc/spots2.f
REAL DTOR, RMINXINP
INTEGER I, ICCX, IXOFFSET, IYOFFSET
LOGICAL CCXRESET, ROTATED
C---- Correct beam coordinates for swing angleif necessary
C NOTE : This code only executed when an IMAGE keyword has been
C given, so only need to consider one image
C AL not necessary XCENMM(1,1)=XMM(1)
C
C AL change to YCENMM YCENMM(1,1)=YSCAL*YMM(1)
C HRP watch for beam set from image header
yscal = 1
dtor = atan(1.0) / 45.0
IF(IBEAM.NE.3)YCENMM(1,1)=YSCAL*YCENMMIN(1)
IF ((TWOTHETA.NE.0.0).AND.(ISWUNG.EQ.0)) THEN
C AL XCENMM(1,1) = XCENMM(1,1) +
C AL + COS(OMEGAF)*0.01*XTOFD*TAN(TWOTHETA*DTOR)
C AL YCENMM(1,1) = YCENMM(1,1) +
C AL + SIN(OMEGAF)*YSCAL*0.01*XTOFD*TAN(TWOTHETA*DTOR)
XCENMM(1,1) = XCENMMIN(1) +
+ COS(OMEGAF)*0.01*XTOFD*TAN(TWOTHETA*DTOR)
YCENMM(1,1) = YCENMMIN(1) +
+ SIN(OMEGAF)*YSCAL*0.01*XTOFD*TAN(TWOTHETA*DTOR)
END IF
C
C---- machine specific code ---- JUPITER CCD
C
IF((MACHINE.EQ.'JUPI').OR.(MACHINE.EQ.'ADSC').OR.
$ (MACHINE.EQ.'BRUK'))THEN
IF(IBEAM.EQ.3)THEN
XCENMM(1,1) = HBEAMX
YCENMM(1,1) = HBEAMY
XCENMMIN(1) = HBEAMX
YCENMMIN(1) = HBEAMY
XMM(1) = HBEAMX
YMM(1) = HBEAMY
WRITE(IOUT,FMT=6080)HBEAMX,HBEAMY
IF(ONLINE)WRITE(ITOUT,FMT=6080)HBEAMX,HBEAMY
ELSE IF(IBEAM.EQ.2)THEN
IF((ABS(HBEAMX-XMM(1)).GT.1E-3).or.
$ (ABS(HBEAMY-YMM(1)).GT.1E-3))THEN
WRITE(IOUT,FMT=6082)XMM(1),YMM(1),
$ HBEAMX,HBEAMY
IF(ONLINE)WRITE(ITOUT,FMT=6082)XMM(1),YMM(1),
$ HBEAMX,HBEAMY
ELSE
WRITE(IOUT,FMT=6084)XMM(1),YMM(1)
IF(ONLINE)WRITE(ITOUT,FMT=6084)XMM(1),YMM(1)
END IF
6080 FORMAT(/,' Main beam position has been calculated as ',
$ F7.2,'mm ',F7.2,'mm ',
$ 'from parameters',/,' in the image header.',
$ 'You should check ',
$ 'these values carefully as they may',/,
$ ' be in error!',/)
6082 FORMAT(4(/,'***** WARNING *****'),/,
$ ' Input beam coordinates ',F7.2,'mm ',F7.2,
$ 'mm DO NOT agree with ',/,' those calcula',
$ 'ted from the image header (',F7.2,'mm ',
$ F7.2,'mm)',/)
6084 FORMAT(/,' Input beam coordinates ',F7.2,'mm ',
$ F7.2,'mm will be used',/)
END IF
END IF
C
C---- Set direct beam coordinates to middle of image if not supplied on a
C BEAM keyword
C
IF (IBEAM.EQ.0) THEN
XCENMM(1,1) = 0.5*NREC*RAST
YCENMM(1,1) = 0.5*IYLEN*RAST*YSCAL
XCENMMIN(1) = 0.5*NREC*RAST
YCENMMIN(1) = 0.5*IYLEN*RAST*YSCAL
XMM(1) = 0.5*NREC*RAST
YMM(1) = 0.5*IYLEN*RAST*YSCAL
END IF
C
C---- For Mar, Fuji (at chess) etc image plate data, correct direct beam
C X coordinate for inversion of image.
C Raster size is RAST mm
C
IF (INVERTX) THEN
DO 698 I = 1,MAXPAX
XCENMM(I,1) = NREC*RAST - XCENMMIN(I)
C
C---- Because we have to use XCENMMIN here, must apply correction
C for swung detectors
C
IF ((TWOTHETA.NE.0.0).AND.(ISWUNG.EQ.0)) THEN
XCENMM(I,1) = XCENMM(I,1) +
+ COS(OMEGAF)*0.01*XTOFD*TAN(TWOTHETA*DTOR)
END IF
698 CONTINUE
IF (RSCANX.NE.0.0) RSCANX = 100.0*NREC*RAST - RSCANX
chrp270202 IF (RMINXINP.NE.0.0) RMINX = 100.0*NREC*RAST - RMINXINP
C
C---- Only change CCX if it was read in from input. It may have been
C passed from the previous round of a multi-segment post refinement
C in which case it MUST NOT be reset.
C
chrp270202 IF ((ICCX.EQ.1).AND.(.NOT.CCXRESET)) THEN
chrp270202 CCX = -CCX
chrp270202 CCXRESET = .TRUE.
chrp270202 END IF
END IF
C
C---- If detector is swung out, correct direct beam coordinates
C (if keyword SWUNG_OUT is given the beam coordinates are assumed
C to be those with the detector set at the given two-theta angle.
C
IF (ISWUNG.EQ.1) THEN
XCEN0 = NINT(100.0*XCENMM(1,1) -
+ COS(OMEGAF)*XTOFD*TAN(TWOTHETA*DTOR))
YCEN0 = NINT(100.0*YCENMM(1,1) -
+ SIN(OMEGAF)*XTOFD*TAN(TWOTHETA*DTOR))
ELSE
C AL XCEN0 = NINT(100.0*XMM(1))
XCEN0 = NINT(100.0*XCENMMIN(1))
IF (INVERTX) XCEN0 = NINT(100.0*(NREC*RAST-XCENMMIN(1)))
C AL YCEN0 = NINT(100.0*YMM(1))
YCEN0 = NINT(100.0*YCENMMIN(1))
END IF
C
C---- Find spots if requested
C
C
C---- Set up default radial background direction
C
ROTATED = ((ABS(OMEGAF/DTOR).LT.1.0).OR.
+ ((ABS(OMEGAF/DTOR-180.0)).LT.1.0))
C
chrp270202 IF ((IXOFFSET.EQ.0).AND.(IYOFFSET.EQ.0)) THEN
chrp270202 RADX = ROTATED
chrp270202 RADY = (.NOT.RADX)
chrp270202 END IF
C
C---- Assign a RMIN, RMAX if not defaulted, to 0.05 and 0.45 of image size
C
IF (ROTATED) THEN
IF (RMINSP.EQ.0) RMINSP = NREC*RAST*0.05
IF (RMAXSP.EQ.0) RMAXSP = NREC*RAST*0.45
ELSE
IF (RMINSP.EQ.0) RMINSP = IYLEN*RAST*0.05
IF (RMAXSP.EQ.0) RMAXSP = IYLEN*RAST*0.45
END IF
C
C---- Check for an offset detector, and if necessary, change the direction
C that the background strip is measured in.
C
IF ((ABS(XCENMM(1,1)-NREC*RAST*0.5).GT.0.045*NREC*RAST).AND.
+ (ROTATED)) THEN
RMINSP = SIGN(RMINSP,(NREC*RAST*0.5-XCENMM(1,1)))
RMAXSP = SIGN(RMAXSP,(NREC*RAST*0.5-XCENMM(1,1)))
END IF
IF ((ABS(YCENMM(1,1)-IYLEN*RAST*0.5).GT.0.045*IYLEN*RAST).AND.
+ (.NOT.ROTATED)) THEN
RMINSP = SIGN(RMINSP,(IYLEN*RAST*0.5-YCENMM(1,1)))
RMAXSP = SIGN(RMAXSP,(IYLEN*RAST*0.5-YCENMM(1,1)))
END IF
C
C
XCEN = 100.0*XCENMM(1,1)
YCEN = 100.0*YCENMM(1,1)
write(*, *) 'xcen = ', xcen, 'ycen = ', ycen
end
C
SUBROUTINE XYC2PX(XPIX, YPIX, XC, YC, ISTAT)
C ============================================
C
C convert mm coordinates XC,YC in scanner coord frame to (real)
C pixel coordinate XPIX,YPIX
C ie just divide by pixel size
C
C .. Parameters ..
C&&*&& include ../inc/parameter.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file parameter.h
C---- START of include file parameter.h
C
C PARAMETERS
C IYLENGTH.. maximum number of I*2 words of data in the
C "fast" (ie most rapidly changing) direction in the
C digitised image. This will be HALF the number of pixels
C for film data (each pixel is stored in one byte)
C but will equal the number of pixels for IP data.
C IXWDTH... The maximum number of "stripes" of data in the scanned image
C ie the number of pixels in the "slow" direction
C (This is the Y direction in the MOSFLM convention)
C Note that the array "IMAGE" used to store the image is
C declared as size IYLENGTH*IXWDTH I*2 words for IP data
C and 2*IYLENGTH*IXWDTH BYTES for film data.
C If this exceeds the
C available memory, set ixwdth=1, recompile program
C and use keyword "NOCORE" when running program.
C Note that for the POSTREF and ADDPART options,
C two images have to be stored in memory at once so
C IXWDTH should be twice the number of records in an
C image.
C MAXHEAD maximum length of image header (in 4 byte words)
C NREFLS.... maximum number of spots per film in generate file (10000)
C MAXBOX.... maximum number of pixels in measurement box (1000)
C MAXDIM.... maximum box size in either direction (pixels) (41)
C MAXPAX.... maximum number of packs per generate file (1000)
C MXDOV2..... maxdim/2
C MAXBUFF... maximum size of buffer (I*2) for storing ods
C of active spots in subroutine meas(20000).
C Must be .GE. MAXBOX*(NNLINE-1) for subroutine process
C MREF...... maximum number of reflections to be used in post
C refinement (6000)
C NEXPAND... maximum number of expansions of the input measurement
C box (2)
C NMASKS.... maximum number of different profiles (25). Note the
C connection between this parameter and NNLINE
C NVECT..... maximum number of vectors for storing scanned image
C in filmplot (10000)
C NIMAX..... maximum number of images to be used together in
C postrefinement (NADD or WIDTH options) (30)
C NNLINE... maximum number of boundary lines for setting up
C the areas for profile fitting. The maximum possible
C number of standard profiles will be (NNLINE-1)**2
C although for a circular detector the actual number
C may be less than this as some boxes will lie entirely
C outside the detector.
C NREJMAX... Maximum number of rejected background pixels, resulting
C either from overlap of adjacent spots or outliers from
C the background plane
C NSPOTS... Maximum number of found spots (for autoindexing) that can
C be stored (for all images). Also maximum number in
C a file wriitten by IMSTILLS that can be
C stored/displayed/edited. THis must be an even number
C MCOLS.... Number of columns in output MTZ file
C MCOLSTR.. Number of columns in output MTZ file for strategy option
C
C MTZ Orientation block
C MBLENG is total length of block, MBLINT, MBLREA are numbers
C of integers & reals
C NRPAR.... Maximum number of refineable parameters for detector
C positional refinement (subroutine RDIST)
C NSEGMAX.. Maximum number of segments in STRATEGY
C MULTMAX... Maximum number of observations with same hkl in COMPLETE
C MAXDIFF... Maximum number of different packs that a given hkl occurs on
C NRESBIN... Maximum number of resolution bins (COMPLETE)
C
C MAXIMG... Maximum number of images that can be read in using the IMAGE
C keyword or the "read Image" menu option.
C MXSPOT... Maximum number of spots that can be found on one image
C (before rejection on spot size).
C MXCENT... Maximum number of active spots during spot finding
C (findspots)
C
C MGRA, NGRA... maximum number of reflections and images over which a
C reflection can be spread for postrefinement.
C
C .. Parameters ..
INTEGER IXWDTH
PARAMETER (IXWDTH=8192)
c PARAMETER (IXWDTH=12288)
INTEGER IYLENGTH
PARAMETER (IYLENGTH=4096)
c PARAMETER (IYLENGTH=6144)
INTEGER MAXHEAD
PARAMETER (MAXHEAD=5000)
INTEGER MAXBOX
PARAMETER (MAXBOX=1500)
INTEGER MAXBUFF
PARAMETER (MAXBUFF=20000)
INTEGER MAXDIM
PARAMETER (MAXDIM=41)
INTEGER MAXPAX
PARAMETER (MAXPAX=1000)
INTEGER MXDOV2
PARAMETER (MXDOV2=MAXDIM/2)
INTEGER NEXPAND
PARAMETER (NEXPAND=2)
INTEGER NMASKS
PARAMETER (NMASKS=25)
INTEGER NREFLS
PARAMETER (NREFLS=100000)
INTEGER MREF
PARAMETER (MREF=6000)
INTEGER NVECT
PARAMETER (NVECT=10000)
INTEGER NIMAX
PARAMETER (NIMAX=30)
INTEGER NNLINE
PARAMETER (NNLINE=6)
INTEGER NREJMAX
PARAMETER (NREJMAX=600)
INTEGER NSPOTS
PARAMETER (NSPOTS=5000)
INTEGER MCOLS
PARAMETER (MCOLS=16)
INTEGER MCOLSTR
PARAMETER (MCOLSTR=6)
INTEGER NREFSTR
C
C---- Each reflection for strategy run needs MCOLSTR I*2 words
C plus an I*4 word for the merging
C
PARAMETER (NREFSTR = IXWDTH*IYLENGTH/(2+MCOLSTR))
INTEGER MBLENG,MBLINT,MBLREA
PARAMETER (MBLENG=185,MBLINT=29,MBLREA=156)
INTEGER NRPAR
PARAMETER (NRPAR=14)
INTEGER NSEGMAX
PARAMETER (NSEGMAX=100)
INTEGER MULTMAX
PARAMETER (MULTMAX=100)
INTEGER MAXDIFF
PARAMETER (MAXDIFF=100)
INTEGER NRESBIN
PARAMETER (NRESBIN=20)
INTEGER MXSPOT
PARAMETER (MXSPOT=5000)
INTEGER MAXIMG
PARAMETER (MAXIMG=100)
INTEGER NPIXBG
PARAMETER (NPIXBG=51)
INTEGER MXCENT
PARAMETER (MXCENT=500)
INTEGER NGRA,MGRA
PARAMETER (NGRA=20)
PARAMETER (MGRA=20000)
C&&*&& end_include ../inc/parameter.f
C
C
C
REAL XPIX,YPIX, XC, YC
INTEGER ISTAT
C
C&&*&& include ../inc/scn.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file scn.h
C---- START of include file scn.h
C
C SCNSZ is pixel size (in microns) divided by 25
C RAST pixel size in slow direction in mm
C FACT multiplying by FACT converts from 10 micron units
C (the standard unit internal to the program) into pixels
C IYLEN The number of pixels in the Y (fastest changing) direction
C in the digitised image.
C NREC The number of pixels in the X (slow) direction in the
C digitised image.
C NWORD The number of I*2 words in the Y direction.
C NBYTE The number of bytes in Y direction = NWORD/2
C NHBYTE Number of bytes in header
C
C ICURR When several images are stored in a single file, ICURR is the
C pointer to the first record of the current image in the direct
C access file (only implemented for film data)
C NEXTRA The number of additional (unused) bytes padding the end of
C each record in image file
C BYTSWAP True if the "endedness" (Big-endian/Little-endian) of the
C machine that MOSFLM is running on is different to that of the
C machine on which the image was written. This is determined by
C looking at the value of NXPIX in the header record of the
C image file (subroutine GETHDR)
C
C .. Scalars in common block /SCN/ ..
REAL FACT,SCNSZ,RAST
INTEGER NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,NHBYTE
LOGICAL BYTSWAP
C ..
C .. Common Block /SCN/ ..
COMMON /SCN/ FACT,SCNSZ,RAST,NBYTE,NREC,NWORD,IYLEN,ICURR,NEXTRA,
+ NHBYTE,BYTSWAP
C&&*&& end_include ../inc/scn.f
C&&*&& include ../inc/ori.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ori.h
C---- START of include file ori.h
C
C XCEN,YCEN Coordinates (in 10 micron units) of the direct beam
C position relative to an origin at the position of the
C first pixel in the digitised image.(The SCANNER
C coordinate frame). These parameters are refined for
C each image.
C
C XCEN0,YCEN0 Coordinates of direct beam position at zero swing angle.
C (Needed for pxtomm conversion for swung detectors)
C These values are assigned on the basis of input direct
C beam coordinates, corrected for swing angle if necessary.
C They are not (currently) updated during refinement.
C
C XOFF,YOFF Distance between centre of detector and direct beam.
C
C ..
C .. Arrays in common /ORI/ ..
LOGICAL FIXPAR
C
C .. Scalars in common block /ORI/ ..
REAL COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
+ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
+ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,YCEN0,
+ XOFF,YOFF,TILTMAT,TWISTMAT,DETNOR,DPSIX
INTEGER CBAR,NODES,NPHI,IJUNK2,IJUNK3
LOGICAL RESETCCOM
C ..
C .. Common Block /ORI/ ..
COMMON /ORI/COSOM0,SINOM0,XTOFRA,YSCAL,TILT,TWIST,BULGE,
$ VBNEG,VBPOS,VTILT,VTWIST,VVERT,TOFF,BULGE2,PBULGE,ROFF,
$ RDTOFF,RDROFF,ROFFPHI,TOFFPHI,JUNK3,XCEN,YCEN,XCEN0,
+ YCEN0,XOFF,YOFF,TILTMAT,TWISTMAT,DPSIX,DETNOR(3),CBAR,
+ NODES,NPHI,IJUNK2,IJUNK3,FIXPAR(NRPAR),
$ RESETCCOM
C ..
C
C
C&&*&& end_include ../inc/ori.f
C
C
XPIX = XC / RAST
YPIX = YC * YSCAL/RAST
C
C Check limits? ISTAT is 0 if reflection falls on the detector,
C ISTAT is -1 if the reflection does not.
C
ISTAT = 0
IF ( (YPIX .LT. 1.) .OR. (YPIX .GT. REAL(IYLEN-1))
+ .OR. (XPIX .LT. 1.) .OR. (XPIX .GT. REAL(NREC-1))) ISTAT = -1
RETURN
END
C== XYSHIFT ==
SUBROUTINE XYSHIFT(XSHIFT,YSHIFT,IX,IY,XSH,YSH,NSH,K)
C =====================================================
C
C IX,IY are the spot coordinates in 10 micron units relative to the
C direct beam position (XCEN,YCEN)
C
IMPLICIT NONE
C
C .. Scalar Arguments ..
REAL XSHIFT,YSHIFT
INTEGER IX,IY,K
C ..
C .. Array Arguments ..
REAL XSH(*),YSH(*)
INTEGER NSH(*)
C ..
C .. Local Scalars ..
INTEGER I,INT,J
C ..
C .. External Subroutines ..
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C&&*&& include ../inc/lmb.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file lmb.h
C---- START of include file lmb.h
C ODSCAL is to scale image numbers into the range 0-255 for plotting
C average profiles.
C GAIN should be equal to the overall gain (image counts per X-ray photon)
C of the system, and is used to evaluate standard deviations based on
C counting statistics assuming independent pixels (ie point spread function
C less than pixel size).
C INVERTX true if image is inverted in the slow (X) direction when read in.
C ISCAL is to scale final integrated intensities and sigmas
C IDIVIDE is the adc offset
C ICONST is a constant to be added to all pixels (normally zero) to
C allow processing of images with zero pixel values in the scanned
C area.
C IMGP is true if working with image plate data
C SPIRAL is true for scanners with a spiral readout (Mar, DIP2000)
C ORTHOG is true for scanners with orthogonal scan (FUJI, RAXIS, MD)
C NULLPIX is the value of pixels within the image but not in the active
C area of the detector
C TILED is true if there are inactive areas of the detector within the
C inscribing circle or square.
C
C NTILEX Number of tiles in X direction
C NTILEY Number of tiles in Y direction
C TILEX X Coordinates of the midpoints of the null areas between tiles
C TILEY Y Coordinates of the midpoints of the null areas between tiles
C TILEWX Width of the null areas between tiles in X
C TILEWY Width of the null areas between tiles in Y
C MACHINE and MODEL denote the type of detector.
C
C MACHINE is used in the following subroutines:
C GETBLK, GETHDR, INTPXL, INTPXL2, MXDSPL, OPENODS, PROCESS, PUTPXL
C Currently coded types are:
C
C MACHINE MODEL COMMENTS
C ======= ===== ========
C MAR 180, 300, 345
C RAXI(S) RAXISII, RAXISIV
C MD
C FUJI
C CCD1 CCD1 Princetown CCD at CHESS,Tiff format
C CCD2 CCD ? ESRF CCD detector
C ADSC QUAD1 ADSC 2x2 CCD detector
C
C .. Scalars in Common Block /LMB/ ..
REAL ODSCAL,GAIN,LOGA,LOGB
INTEGER ISCAL,IDIVIDE,ICONST,NULLPIX,NTILEX,NTILEY
LOGICAL IMGP,INVERTX,SPIRAL,ORTHOG,CIRCULAR,TILED,SETADC
CHARACTER MACHINE*4,MODEL*8
C ..
C .. Arrays in common /LMB/
INTEGER TILEX,TILEY,TILEWX,TILEWY
C
C .. Common Block /LMB/ ..
COMMON /LMB/ ODSCAL,GAIN,LOGA,LOGB,ISCAL,IDIVIDE,ICONST,
+ NULLPIX,NTILEX,NTILEY,TILEX(20),TILEY(20),
+ TILEWX(20),TILEWY(20),IMGP,INVERTX,SPIRAL,
+ ORTHOG,CIRCULAR,TILED,SETADC
COMMON /LMBC/ MACHINE,MODEL
C&&*&& end_include ../inc/lmb.f
C&&*&& include ../inc/misc.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file misc.h
C---- START of include file misc.h
C
C
C
C .. Scalars in common /MISC/ ..
REAL PHIBEG,PHIEND,RMIN,RMAX,WAVE
INTEGER IPACKID,MININT,IERRFLG
C ..
C .. Arrays in common /MISC/ ..
REAL DELPHI,RESANI
INTEGER IAX
C ..
C .. LOGICAL
LOGICAL ANITES
C ..
C .. Common Block /MISC/ ..
COMMON /MISC/DELPHI(3),RESANI(3),PHIBEG,PHIEND,RMIN,RMAX,WAVE,
$ IAX(3),IPACKID,MININT,IERRFLG,ANITES
C ..
C
C
C&&*&& end_include ../inc/misc.f
C ..
SAVE
C
C
IF (K.EQ.1) THEN
C
C---- Set the bin size to half the maximum radius
C
INT = RMAX/2
C
I = 2
C
C
IF (IX.GT.0) I = 3
IF (IX.GT.INT) I = 4
IF (IX.LT.-INT) I = 1
C
C
J = 4
IF (IY.GT.INT) J = 0
IF (IY.LT.0) J = 8
IF (IY.LT.-INT) J = 12
I = I + J
C
C
XSH(I) = XSH(I) + XSHIFT
YSH(I) = YSH(I) + YSHIFT
NSH(I) = NSH(I) + 1
C
C
ELSE IF (K.EQ.2) THEN
C
C
DO 10 J = 1,16
C
C
IF (NSH(J).NE.0) THEN
XSH(J) = XSH(J)/NSH(J)
YSH(J) = YSH(J)/NSH(J)
END IF
C
C
10 CONTINUE
C
C ******************
C ******************
C
WRITE (IOUT,FMT=6000) 0.01*INT
IF (ONLINE) WRITE (ITOUT,FMT=6000) 0.01*INT
WRITE (IOUT,FMT=6002) (NSH(I),0.01*XSH(I),0.01*YSH(I),I=1,16)
IF (ONLINE) WRITE (ITOUT,FMT=6002) (NSH(I),0.01*XSH(I),
+ 0.01*YSH(I),I=1,16)
END IF
C
C---- Format statements
C
6000 FORMAT (//1X,' Analysis of c. of g. shifts for full spots (mm)',
+ ' (Bin size is',F5.0,' mm)',/,
+ 1X,' No. DX DY No. DX ',
+ 'DY No. DX DY No. DX DY')
6002 FORMAT ((I4,2F7.3,3(I6,2F7.3)),/)
C
C
END
C== XYSPOT ==
C
C
C
SUBROUTINE XYSPOT(YA,YB,ZA,DSTSQD,CSISQD,X,Y)
C =============================================
C
C---- Calculate detector coords X,Y
C Extended to swung out detectors 1 July 1994, assuming that the
C two-theta arm has a rotation axis parallel to the crystal rotation
C axis (detector axis Yd)
C
C
C
C .. Scalar Arguments ..
REAL CSISQD,DSTSQD,X,Y,YA,YB,ZA
C ..
C .. Local Scalars ..
REAL DST4,TANUPS,TERM,YMAX,XX,PHI,CPHI,PHID,TPSI,DTR
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,SIGN,SQRT
C ..
C .. Common blocks ..
C&&*&& include ../inc/xy.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file xy.h
C---- START of include file xy.h
C
C .. Scalars in common block /XY/ ..
REAL XTOFD,SINV,COSV,TANV,TWOTHETA
INTEGER ICASS
C ..
C .. Common Block /XY/ ..
COMMON /XY/XTOFD,SINV,COSV,TANV,TWOTHETA,ICASS
C ..
C
C XTOFD.... Crystal to detector distance in 10 micron units. Read from
C keyworded input and never changed.
C
C Spot positions are calculated in S/R XYSPOT (Called from
C REEK) and are for an "ideal" detector at a distance of XTOFD.
C These are converted into pixel positions in S/R MMTOPX
C which applies the multiplicative factor XTOFRA to allow
C for refinement of the distance. XTOFRA is the parameter
C that is actually refined (in RDIST), rather than XTOFD.
C The refined distance that is printed in the logfile is
C actually XTOFRA*XTOFD
C
C ICASS.... Indicates detector type:
C 0 Flat film
C 1 Vee shaped cassettes
C 2 FAST detector (only used in TESTGEN mode of OSCGEN)
C 3 Swung out FAST (ditto)
C 4 IP detector
C TWOTHETA Detector swing angle (degrees)
C&&*&& end_include ../inc/xy.f
C ..
SAVE
C
C
DST4 = DSTSQD**2*0.25
TERM = 2.0*XTOFD/ (2.0-DSTSQD)
C
C---- Flat film
C
XX = CSISQD - DST4
C
C---- Must allow for reflections within the cusp, XX may go -ve
C
IF (XX.LT.0.0) XX = 0.0
X = SQRT(XX)*TERM
Y = ZA*TERM
C
C---- Vee-shaped film
C
IF (ICASS.EQ.1) THEN
TANUPS = X/XTOFD
X = X/ (COSV*TANUPS+SINV)
Y = Y/ (TANUPS/TANV+1.0)
END IF
C
C
YMAX = YA
IF (ABS(YB).GT.ABS(YA)) YMAX = YB
C
C---- X-coordinate has same sign as YMAX
C
X = SIGN(X,YMAX)
C
C
C---- IF detector is swung out (TWOTHETA arm) calculate coords
C
IF (TWOTHETA.EQ.0) RETURN
DTR = ATAN(1.0)/45.0
PHI = ATAN2(X,XTOFD)
CPHI = COS(PHI)
TPSI = (Y*CPHI/XTOFD)
PHID = PHI/DTR
X = XTOFD*(TAN(DTR*(TWOTHETA+PHID)) - TAN(TWOTHETA*DTR))
Y = XTOFD*TPSI/COS(DTR*(TWOTHETA+PHID))
C
END
C== YESNO ==
C
C
C
C
SUBROUTINE YESNO(YES)
C ====================
C
C
C
C .. Scalar Arguments ..
LOGICAL YES
C ..
C .. Local Scalars ..
CHARACTER CH*1
C ..
C .. Common blocks ..
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
C ..
SAVE
C
C
10 CONTINUE
READ (ITIN,FMT=6000,END=90) CH
YES = .FALSE.
C
C
CALL CCPUPC(CH)
C
C
IF ((CH.NE.'Y') .AND. (CH.NE.'N') ) THEN
WRITE (ITOUT,FMT=6002)
GO TO 10
END IF
C
C
IF (CH.EQ.'Y') YES = .TRUE.
IF (CH.EQ.'N') YES = .FALSE.
RETURN
C
C---- Format statements
C
6000 FORMAT (A)
6002 FORMAT (/1X,'ENTER "Y" OR "N" PLEASE !! ')
C
90 YES = .FALSE.
C
END
C
SUBROUTINE TOREFIX(NSOL,BOXOPEN,RFIXCELL,RFIXDIST)
C ==================================================
C
IMPLICIT NONE
C&&*&& include ../inc/ioo.f
C
C $Id: mosflm_all_ip_inc.for,v 1.12 2002/07/01 13:41:20 ccb Exp $
C
C--- awk generated include file ioo.h
C---- START of include file ioo.h
C
C
C
C .. Scalars in common block /IOO/ ..
INTEGER IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,ISUMMR,
+ ICOORD,SERVERFD
LOGICAL ONLINE,ONEFILE,FHEADER,BRIEF,GRAPH,IOERR,
$ NODISPLAY,LBELL,JPGOUT,SOCKLO
C ..
C .. Common block /IOO/ ..
c COMMON /IOO/IOUT,IUNIT,ONLINE,ITIN,ITOUT,INOD,INMO,IDU,NWRN,
c + ONEFILE,FHEADER,BRIEF,IBRIEF,GRAPH,ISUMMR,ICOORD,
c + IOERR,NODISPLAY,LBELL
C ..
C
C
COMMON /IOO/IOUT,IUNIT,ITIN,ITOUT,INOD,INMO,IDU,NWRN,IBRIEF,
+ ISUMMR,ICOORD,SERVERFD,ONLINE,ONEFILE,
+ FHEADER,BRIEF,GRAPH,IOERR,NODISPLAY,LBELL,JPGOUT,
$ SOCKLO
C&&*&& end_include ../inc/ioo.f
LOGICAL BOXOPEN,RFIXCELL,RFIXDIST
INTEGER IXP,IYP,NSOL,L,IBUTTON
INTEGER XDLSTR,LENSTR
CHARACTER*120 LINE
COMMON /ERRFLG/ IERRFLG
INTEGER IERRFLG
EXTERNAL XDLF_POPUP_NOTICE
EXTERNAL XDLSTR,LENSTR
! This is a dummy routine distributed with MOSFLM when REFIX has not been
! requested by the site. If you want REFIX, you must e-mail Andrew Leslie
! andrew@mrc-lmb.cam.ac.uk so that he can send you a copy. All other aspects
! of MOSFLM should work without REFIX.
IF (ONLINE) WRITE(ITOUT,FMT=1000)
WRITE(LINE,FMT=1000)
1000 FORMAT(1X,'This option is only available if you e-mail ',
+'Andrew Leslie and ask for it. Use the new-style indexing ',
+'instead')
L = LENSTR(LINE)
IXP = 400
IYP = 400
CALL XDLF_POPUP_NOTICE(IXP,IYP, XDLSTR(LINE),L,
+ XDLSTR(' '),-1,XDLSTR('OK'),2,XDLSTR(' '),
+ -1,3,0,IBUTTON)
IERRFLG = 1
RETURN
END
C
C
C
C
SUBROUTINE GONSYS(ACHSE,S0L,S0G,EG,IER)
IMPLICIT NONE
INTEGER IER,I
REAL ACHSE(3),S0L(3),S0G(3),EG(3,3)
DO 10 I=1,3
EG(I,2)=ACHSE(I)
10 EG(I,3)=S0L(I)
CALL UNORM(EG,IER)
DO 20 I=1,3
20 S0G(I)=EG(1,I)*S0L(1)+EG(2,I)*S0L(2)+EG(3,I)*S0L(3)
RETURN
END
C
C
C
C
SUBROUTINE UNORM(U,IER)
IMPLICIT NONE
C
C---- normalize matrix u(3,3) to orthogonal form
C
C
INTEGER IER,J
REAL U(3,3),P,Q
IER=-1
P=U(1,2)**2+U(2,2)**2+U(3,2)**2
Q=U(1,2)*U(1,3)+U(2,2)*U(2,3)+U(3,2)*U(3,3)
DO 1 J=1,3
1 U(J,3)=U(J,3)*P-U(J,2)*Q
Q=SQRT(U(1,3)**2+U(2,3)**2+U(3,3)**2)
IF (Q.LT.0.000001)GO TO 3
P=SQRT(P)
DO 2 J=1,3
U(J,2)=U(J,2)/P
2 U(J,3)=U(J,3)/Q
U(1,1)=U(2,2)*U(3,3)-U(2,3)*U(3,2)
U(2,1)=U(3,2)*U(1,3)-U(3,3)*U(1,2)
U(3,1)=U(1,2)*U(2,3)-U(1,3)*U(2,2)
IER=0
3 RETURN
END
C
C
C
C ======================
SUBROUTINE MATCOP(A,B)
C ======================
IMPLICIT NONE
C
C
C
REAL A(3,3),B(3,3)
INTEGER I,J
C
C
DO 1 I=1,3
DO 1 J=1,3
1 B(I,J)=A(I,J)
C
C
RETURN
END
C
C
C
C
C =======================================
SUBROUTINE DGELS(R,A,M,N,EPS,IRANK,AUX)
C =======================================
IMPLICIT NONE
C
C
C
C
C PURPOSE
C TO SOLVE A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH
C SYMMETRIC COEFFICIENT MATRIX UPPER TRIANGULAR PART OF
C WHICH IS ASSUMED TO BE STORED COLUMNWISE.
C
C DESCRIPTION OF PARAMETERS
C R - M BY N RIGHT HAND SIDE MATRIX. (DESTROYED)
C ON RETURN R CONTAINS THE SOLUTION OF THE EQUATIONS.
C A - UPPER TRIANGULAR PART OF THE SYMMETRIC M BY M
C COEFFICIENT MATRIX. (DESTROYED)
C M - THE NUMBER OF EQUATIONS IN THE SYSTEM.
C N - THE NUMBER OF RIGHT HAND SIDE VECTORS.
C EPS - AN INPUT CONSTANT WHICH IS USED AS RELATIVE
C TOLERANCE FOR TEST ON LOSS OF SIGNIFICANCE.
C IRANK - RANK OF MATRIX
C AUX - AN AUXILIARY STORAGE ARRAY OF DIMENSION M-1.
C
C REMARKS
C UPPER TRIANGULAR PART OF MATRIX A IS ASSUMED TO BE STORED
C COLUMNWISE IN M*(M+1)/2 SUCCESSIVE STORAGE LOCATIONS,
C RIGHT HAND SIDE MATRIX R COLUMNWISE IN N*M SUCCESSIVE
C STORAGE LOCATIONS. ON RETURN SOLUTION MATRIX R IS STORED
C COLUMNWISE TOO.
C
C METHOD
C SOLUTION IS DONE BY MEANS OF GAUSS-ELIMINATION WITH PIVOTING
C IN MAIN DIAGONAL, IN ORDER TO PRESERVE SYMMETRY IN REMAINING
C COEFFICIENT MATRICES.
C
C
INTEGER II,I,J,K,L,LL,LLD,LLST,LR,LST,LT,LEND,M,N,NM,IRANK
REAL*8 A(*),R(*),AUX(*),TB,PIV,PIVI,TOL,EPS,ZERO,ONE
PARAMETER (ZERO=0.0D+00,ONE=1.0D+00)
C
C
C
C---- search for greatest main diagonal element
C
IRANK=0
IF (M.LT.1)RETURN
PIV=ZERO
L=0
DO 10 K=1,M
L=L+K
TB=DABS(A(L))
IF (TB.LE.PIV)GO TO 10
PIV=TB
I=L
J=K
10 CONTINUE
TOL=EPS*PIV
IF (TOL.LE.ZERO)RETURN
C
C---- start elimination loop
C
LST=0
NM=N*M
LEND=M-1
DO 100 K=1,M
C
C---- test on usefulness of symmetric algorithm
C
IF (PIV.LE.TOL)THEN
PIVI=ZERO
ELSE
PIVI=ONE/A(I)
IRANK=IRANK+1
ENDIF
LT=J-K
LST=LST+K
C
C---- pivot row reduction and row interchange in right hand side r
C
DO 20 L=K,NM,M
LL=L+LT
TB=PIVI*R(LL)
R(LL)=R(L)
20 R(L)=TB
C
C---- check if elimination is terminated
C
IF (K.GE.M)GO TO 110
C
C---- row and column interchange and pivot row reduction in matrix a.
C elements of pivot column are saved in auxiliary vector aux.
C
LR=LST+(LT*(K+J-1))/2
LL=LR
L=LST
DO 70 II=K,LEND
L=L+II
LL=LL+1
IF (L-LR)50,30,40
30 A(LL)=A(LST)
TB=A(L)
GO TO 60
40 LL=L+LT
50 TB=A(LL)
A(LL)=A(L)
60 AUX(II)=TB
70 A(L)=PIVI*TB
C
C---- save column interchange information
C
A(LST)=LT
C
C---- element reduction and search for next pivot
C
PIV=ZERO
LLST=LST
LT=0
DO 100 II=K,LEND
PIVI=-AUX(II)
LL=LLST
LT=LT+1
DO 80 LLD=II,LEND
LL=LL+LLD
L=LL+LT
80 A(L)=A(L)+PIVI*A(LL)
LLST=LLST+II
LR=LLST+LT
TB=DABS(A(LR))
IF (TB.LE.PIV)GO TO 90
PIV=TB
I=LR
J=II+1
90 DO 100 LR=K,NM,M
LL=LR+LT
100 R(LL)=R(LL)+PIVI*R(LR)
C
C---- end of elimination loop
C back substitution and back interchange
C
110 IF (LEND.LT.1)RETURN
II=M
DO 130 I=2,M
LST=LST-II
II=II-1
L=A(LST)+.5
DO 130 J=II,NM,M
TB=R(J)
LL=J
K=LST
DO 120 LT=II,LEND
LL=LL+1
K=K+LT
120 TB=TB-A(K)*R(LL)
K=J+L
R(J)=R(K)
130 R(K)=TB
RETURN
END
C
C
C
C
C ===============================
SUBROUTINE INVCEL(CELL,RCELL,V)
C ===============================
IMPLICIT NONE
C
C
C
C---- Calculate reciprocal cell parameters from unit cell constants.
C This routine may also be used to calculate the unit cell
C
C Parameters from the reciprocal cell constants.
C
C CELL - unit cell constants : a,b,c,alfa,beta,gamma (given)
C in angstroem and degrees
C RCELL - calculated reciprocal cell parameters (result)
C in reciprocal angstroem and degrees
C V - calculated unit cell volume in angstroem**3 . (result)
C v<=0.0 indicates an error situation.
C
C
INTEGER I,J,K
REAL CELL(6),RCELL(6),CA(3),SA(3),ARG,V
C
C
C
DO 10 I=1,3
ARG=CELL(I+3)/57.29578
CA(I)=COS(ARG)
10 SA(I)=SIN(ARG)
C
C
V=CELL(1)*CELL(2)*CELL(3)*
@ SQRT(1.0+2.0*CA(1)*CA(2)*CA(3)-CA(1)**2-CA(2)**2-CA(3)**2)
IF (V.LE.0.0)GO TO 30
C
C
DO 20 I=1,3
J=MOD(I,3)+1
K=MOD(I+1,3)+1
RCELL(I)=CELL(J)*CELL(K)*SA(I)/V
ARG=57.29578*ACOS((CA(J)*CA(K)-CA(I))/(SA(J)*SA(K)))
J=NINT(ARG)
IF (ABS(ARG-J).LT.0.0009)ARG=J
20 RCELL(I+3)=ARG
C
C
30 RETURN
END
C
C
C
C
C =============================
SUBROUTINE METRIC(B,CELL,IER)
C =============================
IMPLICIT NONE
C
C
C
C
C Calculates cell parameters from unit cell basis vectors
C W.KABSCH 10-1991
C
C
C B - basis vectors of the unit cell (stored row-wise) (given)
C CELL - cell parameters (angstrom & degrees) (result)
C IER - error flag: 0:no error, -1:illegal basis vectors (result)
C
C
C
INTEGER IER,I,J,K
REAL B(3,3),CELL(6),R
C
C
C
C
IER=-1
DO 10 I=1,3
10 CELL(I)=SQRT(B(I,1)*B(I,1)+B(I,2)*B(I,2)+B(I,3)*B(I,3))
DO 20 I=2,3
DO 20 J=1,I-1
R=CELL(I)*CELL(J)
IF (R.LE.0.0)GO TO 30
R=(B(I,1)*B(J,1)+B(I,2)*B(J,2)+B(I,3)*B(J,3))/R
IF (ABS(R).GE.1.0)GO TO 30
K=3+6/(I*J)
20 CELL(K)=57.29578*ACOS(R)
IER=0
30 RETURN
END
C
C
C
C ==========================
SUBROUTINE RFSETMAT(RCELL,A)
C ==========================
IMPLICIT NONE
C
C
C
C---- calculate setting matrix from reciprocal unit cell.
C
C RCELL - RECIPROCAL UNIT CELL PARAMETERS (GIVEN)
C IN RECIPROCAL ANGSTROEM AND DEGREES.
C A - SETTING MATRIX IN STANDARD ORIENTATION (RESULT)
C
C
C
C
C
INTEGER I
REAL RCELL(6),A(3,3),RC(3),RS(3),ARG
DO 10 I=1,3
ARG=RCELL(I+3)/57.29578
RC(I)=COS(ARG)
10 RS(I)=SIN(ARG)
A(1,1)=RCELL(1)*RS(2)
A(1,2)=RCELL(2)*(RC(3)-RC(1)*RC(2))/RS(2)
A(1,3)=0.0
A(2,1)=0.0
A(2,2)=SQRT((RCELL(2)*RS(1))**2-A(1,2)**2)
A(2,3)=0.0
A(3,1)=RCELL(1)*RC(2)
A(3,2)=RCELL(2)*RC(1)
A(3,3)=RCELL(3)
RETURN
END
C
C
C
C
C =================================
SUBROUTINE RTUMAT(ASTV,BSTV,CSTV)
C =================================
IMPLICIT NONE
C
C
C Given the setting matrix found by auto-indexing, this routine
C operates the point group matrices on it to find the one which
C gives the smallest misetting angles which respect to a defined
C U matrix.
C
C The routine DCOSFD is used to work out the unit vector defining
C the axis of rotation and the angle. If we find such vectors for
C each matrix, the test matrix which gives the largest dot product
C with the axis of the target matrix should have the most similar
C rotation axis. But there may be an ambiguity about its sense.
C This can be resolved by finding the matrix with the most
C similar angle of rotation about the axis.
C
C
C NOTES ON ROBUSTNESS:
C We often find two solutions with dot product of the axis vectors
C which are identical. But because of rounding errors in REAL*4
C representation these errors are compounded over the matrix operations
C and conspire to reduce the identity of these products. Here we allow
C a tolerance to the fourth decimal place. For added robustness RFMATMUL
C and INVERS should be double precision. At present single precision
C seems adequate but in certain unforseen circumstances the wrong
C solution may be chosen. Either reduce 1E-4 below or use double
C precision routines from the NAG library.PMcL
C
C
C---- External subroutines required
C
C
C DECOMP,INVERS,RFMATMUL,MATCOP,LAUSEY,RTOMISSET,DCOSFD,UNORM
C
C
C
C
cc IMPLICIT NONE
C .. Array Arguments ..
REAL ASTV(3),BSTV(3),CSTV(3)
C ..
C .. Scalars in Common ..
REAL CCOM,CCX,CCY,DPHI,F,FLAMDA,ORGX,ORGY,Q,THRESH,DXY
INTEGER FIXF,IGROUP
LOGICAL DCOMP,FILM,LCAMC,TARGET
INTEGER LP,LINOUT
LOGICAL ONLINE
C ..
C .. Arrays in Common ..
REAL ACHSE,CELL,ED,S0,TARMAT
C ..
C .. Local Scalars ..
DOUBLE PRECISION BEST,PROD
REAL BESTA,D,TEST,TRACE,TRACEU
INTEGER IBEST,IER,J,J1,K,K1,K2,NEQ
C ..
C .. Local Arrays ..
REAL AMAT(3,3),ANG(3,24),BINV(3,3),BMAT(3,3),DUM(3,3),EUTAR(3),
+ EUTEST(3),I(3,3),L(3,3),LBINV(3,3),LINV(3,3),LUINV(3,3),
+ PHI(3),RMAT(3,3),UINV(3,3),UMAT(3,3),UTAR(3,3),UTEST(3,3)
INTEGER MLAUE(432)
C ..
C .. External Subroutines ..
EXTERNAL DCOSFD,DECOMP,INVERS,LAUESY,MATCOP,RFMATMUL,RTOMISSET,
+ UNORM
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS
C ..
C .. Common blocks ..
COMMON /REFCOM/IGROUP,FLAMDA,CELL(6),F,THRESH,Q,DPHI,ED(3,3),
+ ACHSE(3),S0(3),ORGX,ORGY,FIXF,TARMAT(3,3),TARGET,DCOMP,
+ LCAMC,CCX,CCY,CCOM,FILM,DXY,FIXCELL
LOGICAL FIXCELL
COMMON /RINOUT/ ONLINE,LP,LINOUT
C ..
SAVE
C .. Data statements ..
C
C
DATA I/1,0,0,0,1,0,0,0,1/
DATA MLAUE/432*0/
DATA BEST/1.0E-12/
C ..
C
C
C
C
C---- Make BEST negative, as in P21 both solutions can have -ve dot product
C so no solution is chosen !
C
CAL BEST = 1.0E-12
BEST = -999.0
C
DO 10 K = 1,3
AMAT(K,1) = ASTV(K)
AMAT(K,2) = BSTV(K)
AMAT(K,3) = CSTV(K)
10 CONTINUE
C
C---- DECOMP decomposes AMAT into UMAT*BMAT
C
C **********************
CALL DECOMP(AMAT,UMAT,BMAT)
C **********************
C
C---- If the target matrix was given as an A MATRIX
C then decompose it to get UTAR
C
IF (DCOMP) THEN
C
C ***********************
CALL DECOMP(TARMAT,UTAR,DUM)
C ***********************
C
CAL IF (ONLINE) WRITE (LP,FMT=6000) ((UTAR(K,J),J=1,3),K=1,3)
CAL 6000 FORMAT('U-MATRIX DERIVED FROM INPUT A-MATRIX',/,
CAL + 3(1X,3F10.5,/))
CAL WRITE (LINOUT,FMT=6000) ((UTAR(K,J),J=1,3),K=1,3)
ELSE
C
C *******************
CALL MATCOP(TARMAT,UTAR)
C *******************
C
END IF
C
C *******************
CALL MATCOP(UTAR,TARMAT)
CALL INVERS(UTAR,UINV,D)
CALL INVERS(BMAT,BINV,D)
C *******************
C
C---- Get unit vector along axis of rotation (EUTAR) and
C angle of rotation about that axis (TRACEU) from the
C target setting matrix UTAR
C
C *************************
CALL DCOSFD(UTAR,EUTAR,TRACEU)
C *************************
C
C---- Read Permutation Matrices for the Point Group
C
C *****************************
CALL LAUESY(CELL,IGROUP,NEQ,MLAUE)
C ******************************
C
C---- Main loop over the point group matrices
C
J1 = 0
CAL WRITE (LINOUT,FMT=6030)
CAL 6030 FORMAT(//,1X,
CAL + 'LAUE OPERATOR PHIX PHIY PHIZ')
CAL IF (ONLINE) WRITE (LP,FMT=6030)
C
C
DO 50 K = 1,NEQ
C
C---- Gather point group matrix number K into L(3,3)
C
DO 30 K1 = 1,3
DO 20 K2 = 1,3
J1 = J1 + 1
L(K2,K1) = MLAUE(J1)
20 CONTINUE
30 CONTINUE
C
C---- Calculate the UMAT given this point group matrix.
C
C ********************
CALL INVERS(L,LINV,D)
CALL RFMATMUL(L,UINV,LUINV)
CALL RFMATMUL(UMAT,LUINV,RMAT)
CALL RTOMISSET(RMAT,PHI,1)
CALL RFMATMUL(L,BINV,LBINV)
CALL RFMATMUL(AMAT,LBINV,UTEST)
C ************************
C
C---- Renormalise UTEST to reduce errors built up by matrix
C concatenation.
C
C ****************
CALL UNORM(UTEST,IER)
C ****************
C
C---- Calculate how similar this UMAT is to the target matrix.
C
C Get unit vector along axis of rotation for the candidate
C matrix and the angle of rotation about this axis
C
C *************************
CALL DCOSFD(UTEST,EUTEST,TRACE)
C **************************
C
TEST = ABS(TRACE-TRACEU)
C
C
PROD = EUTEST(1)*EUTAR(1) + EUTEST(2)*EUTAR(2) +
+ EUTEST(3)*EUTAR(3)
C
C---- If the dot product of the axis vectors are larger than the
C best so far, make the current the best. If they are similar
C to the fourth decimal place, then take the one describing
C the smaller angle of rotation
C
C---- Following code changed 9/5/95, previous version would not work
C correctly in some circumstances (eg p21)
C
IF (DABS(PROD-BEST).GT.1.0E-4) THEN
C
C---- This is a different solution
C
IF (PROD.GT.BEST) THEN
BESTA = TEST
BEST = PROD
IBEST = K
END IF
C
ELSE
C
C---- This is a similar solution
C
IF (TEST.LT.BESTA) THEN
BESTA = TEST
BEST = PROD
IBEST = K
END IF
END IF
cal Following is original code
cal IF ((PROD-BEST).GT.1.0E-4) THEN
cal BESTA = ABS(TEST)
cal BEST = DABS(PROD)
cal IBEST = K
cal ELSE IF (DABS(PROD-BEST).LE.1.0E-4 .AND.
cal + DABS(PROD-BEST).GT.0.0) THEN
cal IF (TEST.LT.BESTA) THEN
cal BESTA = ABS(TEST)
cal BEST = DABS(PROD)
cal IBEST = K
cal END IF
cal END IF
C
C
DO 40 K1 = 1,3
ANG(K1,K) = PHI(K1)
40 CONTINUE
C
C
CAL WRITE (LINOUT,FMT='(10X,I2,2x,3(f8.2),/)')
CAL + K,PHI
CAL IF (ONLINE) WRITE (LP,FMT='(10X,I2,2x,3(f8.2),/)') K,PHI
C
CAL WRITE (LINOUT,fmt=6010) IBEST,K,((RMAT(K1,J),J=1,3),K1=1,3)
CAL IF (ONLINE) WRITE(LP,fmt=6010) IBEST,K,
CAL + ((RMAT(K1,J),J=1,3),K1=1,3)
C 6010 FORMAT(1X,'IBEST,K ', 2I5,' RMAT IS',/,3(1X,3F10.4,/))
50 CONTINUE
C
C---- End of Main Loop
C
C---- Now operate the IBEST Laue group matrix on the
C input A matrix
C
J1 = (IBEST-1)*9
C
C
DO 70 K1 = 1,3
DO 60 K2 = 1,3
J1 = J1 + 1
L(K2,K1) = MLAUE(J1)
60 CONTINUE
70 CONTINUE
C
C ******************
CALL RFMATMUL(AMAT,L,DUM)
C ******************
C
DO 80 K = 1,3
ASTV(K) = DUM(K,1)
BSTV(K) = DUM(K,2)
CSTV(K) = DUM(K,3)
80 CONTINUE
C
C
END
C
C
C
C ========================
SUBROUTINE DECOMP(A,U,B)
C ========================
IMPLICIT NONE
C
C
C
C---- Calculate U and B given A.
C
C
C
C
C---- Orientation matrix given explicitly
C
C Set UMAT to (UB)transpose
C
C .. Array Arguments ..
REAL A(3,3),B(3,3),U(3,3)
C ..
C .. Scalars in Common ..
REAL CCOM,CCX,CCY,DPHI,F,FLAMDA,ORGX,ORGY,Q,THRESH,DXY
INTEGER IGROUP,FIXF
LOGICAL DCOMP,FILM,LCAMC,TARGET
INTEGER LP,LINOUT
LOGICAL ONLINE
C ..
C .. Arrays in Common ..
REAL ACHSE,CELL,ED,S0,TARMAT
C ..
C .. Local Scalars ..
REAL D
INTEGER I
C ..
C .. Local Arrays ..
REAL CELLC(6),GMAT(3,3),RCELL(6),XMAT(3,3)
C ..
C .. External Subroutines ..
EXTERNAL BMATRX,CHECKU,CLCALC,INVERS,RFMATMUL,TRANSP
C ..
C .. Common blocks ..
COMMON /REFCOM/IGROUP,FLAMDA,CELL(6),F,THRESH,Q,DPHI,ED(3,3),
+ ACHSE(3),S0(3),ORGX,ORGY,FIXF,TARMAT(3,3),TARGET,DCOMP,
+ LCAMC,CCX,CCY,CCOM,FILM,DXY,FIXCELL
LOGICAL FIXCELL
COMMON /RINOUT/ ONLINE,LP,LINOUT
C ..
SAVE
C
C
C ***********
CALL TRANSP(U,A)
C ***********
C
C---- Get reciprocal metric tensor G**-1 in GMAT, = (UB)T.(UB)
C
C ****************
CALL RFMATMUL(U,A,GMAT)
C ****************
C
C---- Get reciprocal cell dimensions RCELL
C
C ******************
CALL CLCALC(RCELL,GMAT)
C ******************
C
C---- Invert to get real metric tensor G in UMAT
C
C ****************
CALL INVERS(GMAT,U,D)
C ****************
C
C IF (ABS(D).LE.0.000001) THEN
IF (D.EQ.0.0) THEN
WRITE (LINOUT,FMT=6000)
IF (ONLINE) WRITE (LP,FMT=6000)
ELSE
C
C---- Get real cell dimensions from metric tensor
C
C ***************
CALL CLCALC(CELLC,U)
C ***************
C
DO 10 I = 1,3
CELLC(I) = CELLC(I)*FLAMDA
10 CONTINUE
C
C---- Rebuild cell orthogonalization matrix B in BMAT
C
C ****************************
CALL BMATRX(B,RCELL,CELLC,FLAMDA)
C ****************************
C
C---- Get matrix U = (UB).(B**-1) to UMAT
C
C ****************
CALL INVERS(B,XMAT,D)
CALL RFMATMUL(A,XMAT,U)
CALL CHECKU(U)
C *****************
C
END IF
C
C---- Format statements
C
6000 FORMAT (//' !!!! Zero reciprocal cell volume from orientation ma',
+ 'trix !!!!',//)
C
C
END
C
C
C
C ==========================
SUBROUTINE INVERS(A,B,DET)
C ==========================
IMPLICIT NONE
C
C
C
C A - 3 x 3 matrix (given)
C B - 3 x 3 matrix is calculated inverse matrix of a (result)
C DET - calculated determinant of given matrix a (result)
C
C
C
INTEGER I,J,K
REAL A(3,3),B(3,3),DET
C
C
C
DO 1 I=1,3
J=I+1
IF (J.GT.3)J=J-3
K=I+2
IF (K.GT.3)K=K-3
B(I,1)=A(2,J)*A(3,K)-A(2,K)*A(3,J)
B(I,2)=A(3,J)*A(1,K)-A(3,K)*A(1,J)
1 B(I,3)=A(1,J)*A(2,K)-A(1,K)*A(2,J)
C
C
DET=A(1,1)*B(1,1)+A(1,2)*B(2,1)+A(1,3)*B(3,1)
IF (DET.EQ.0.0)GO TO 3
C
C
DO 2 I=1,3
DO 2 J=1,3
2 B(I,J)=B(I,J)/DET
3 RETURN
END
C
C
C
C ===================================
SUBROUTINE DCOSFD(ROT,DIRCOS,KAPPA)
C ===================================
IMPLICIT NONE
C
C
C Given a rotation matrix ROTN, expressing a rotation
C through an angle KAPPA right-handedly about an axis
C with direction cosines DIRCOS(I),
C DCOSFD determines DIRCOS() and KAPPA
C KAPPA is returned in degrees in the range 0 to 180
C
C Expression for rotation matrix is (see J & J, "Mathl.
C Phys.", p. 122):-
C
C cw + n(1)n(1)(1-cw) n(1)n(2)(1-cw)-n(3)sw n(1)n(3)(1-cw)+n(3)sw
C n(1)n(2)(1-cw)+n(3)sw cw + n(2)n(2)(1-cw) n(2)n(3)(1-cw)-n(1)sw
C n(3)n(1)(1-cw)-n(2)sw n(3)n(2)(1-cw)+n(1)sw cw + n(3)n(3)(1-cw)
C
C where cw = cos(KAPPA), sw = sin(KAPPA),
C & n(1), n(2), n(3) are the direction cosines.
C
C
C
C
C
C
C
C .. Scalar Arguments ..
REAL KAPPA
C ..
C .. Array Arguments ..
REAL DIRCOS(3),ROT(3,3)
C ..
INTEGER LP,LINOUT
LOGICAL ONLINE
C .. Local Scalars ..
REAL COSKAP,DIFF,PI,R2,R3,SINKAP,TRACE
INTEGER J,JMX,KNTRL
C ..
C .. Local Arrays ..
REAL D(3),P(3),S(3)
INTEGER NCS(3),ND(3),NP(3),NS(3)
C ..
C .. External Subroutines ..
EXTERNAL ORDR3
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,ATAN,ATAN2,SQRT
C ..
COMMON /RINOUT/ ONLINE,LP,LINOUT
C
C
SAVE
C
C
DIFF = 1.0E-04
PI = ATAN(1.0)*4.0
KNTRL = 0
C
C---- Trace = 1 + 2.cos w
C
TRACE = ROT(1,1) + ROT(2,2) + ROT(3,3)
C
C---- S(1)=2.n(1).sin w
C S(2)=2.n(2).sin w
C S(3)=2.n(3).sin w
C
S(1) = ROT(3,2) - ROT(2,3)
S(2) = ROT(1,3) - ROT(3,1)
S(3) = ROT(2,1) - ROT(1,2)
C
C *****************
CALL ORDR3(KNTRL,S,NS)
C *****************
C
C---- Is biggest S() zero (i.e. is sin w = 0)?
C
IF (ABS(S(NS(1))).GT.DIFF) THEN
R2 = S(NS(2))/S(NS(1))
R3 = S(NS(3))/S(NS(1))
DIRCOS(NS(1)) = 1.0/SQRT(R2**2+1+R3**2)
DIRCOS(NS(2)) = DIRCOS(NS(1))*R2
DIRCOS(NS(3)) = DIRCOS(NS(1))*R3
ELSE
C
C---- Calculation when sin w = 0 (esp. when w = 180').
C P(1)=n(2).n(3).{0(W=0)or2(w=180)}
C P(2)=n(3).n(1).{0(W=0)or2(w=180)}
C P(3)=n(1).n(2).{0(W=0)or2(w=180)}
C
P(1) = ROT(3,2)
P(2) = ROT(1,3)
P(3) = ROT(2,1)
C
C *****************
CALL ORDR3(KNTRL,P,NP)
C *****************
C
C---- Is biggest P() zero (i.e. are all off-diag. terms zero)?
C
IF (ABS(P(NP(1))).LT.DIFF) THEN
IF (TRACE.GT.0.0) THEN
C
C---- Matrix is unit matrix.
C
KAPPA = 0.0
DIRCOS(1) = 0.0
DIRCOS(2) = 0.0
DIRCOS(3) = 1.0
ELSE
C
C---- Trace -ve, so dyad about x,y or z.
C
KAPPA = PI
C
C
DO 10 J = 1,3
D(J) = ROT(J,J) + 1.0
10 CONTINUE
C
C *****************
CALL ORDR3(KNTRL,D,ND)
C *****************
C
DIRCOS(ND(1)) = 1.0
DIRCOS(ND(2)) = 0.0
DIRCOS(ND(3)) = 0.0
END IF
RETURN
C
C
ELSE IF (ABS(P(NP(2))).LT.DIFF) THEN
C
C---- One d.c. is zero.
C
DIRCOS(NP(1)) = 0.0
DIRCOS(NP(2)) = SQRT((ROT(NP(2),NP(2))+1.0)*0.5)
DIRCOS(NP(3)) = SQRT((ROT(NP(3),NP(3))+1.0)*0.5)
IF (P(NP(1)).LT.0.0) DIRCOS(NP(2)) = -DIRCOS(NP(2))
ELSE
C
C---- All d.c's are nonzero.
C R2=n(NP(1))/n(NP(2))
C R3=n(NP(1))/n(NP(3))
C
R2 = P(NP(2))/P(NP(1))
R3 = P(NP(3))/P(NP(1))
DIRCOS(NP(2)) = 1.0/SQRT(R2**2+1+ (R2/R3)**2)
DIRCOS(NP(3)) = 1.0/SQRT(R3**2+1+ (R3/R2)**2)
DIRCOS(NP(1)) = SQRT(1.0-DIRCOS(NP(2))**2-DIRCOS(NP(3))**2)
C
C---- Adjust signs of DIRCOS().
C
JMX = 0
C
C
DO 20 J = 1,3
IF (P(J).GT.0.0) THEN
IF (JMX.GT.0) JMX = -1
IF (JMX.EQ.0) JMX = J
END IF
20 CONTINUE
C
C
IF (JMX.GT.0) DIRCOS(JMX) = -DIRCOS(JMX)
IF (JMX.EQ.0) WRITE (LINOUT,FMT=6000)
IF (JMX.EQ.0.AND.ONLINE) WRITE (LP,FMT=6000)
END IF
END IF
C
C---- Given d.c's, calculate KAPPA.
C
KNTRL = 1
C
C ***********************
CALL ORDR3(KNTRL,DIRCOS,NCS)
C ***********************
C
C---- Find KAPPA.
C
SINKAP = ROT(NCS(3),NCS(2)) - ROT(NCS(2),NCS(3))
SINKAP = 0.5*SINKAP/DIRCOS(NCS(1))
COSKAP = (TRACE-1.0)*0.5
KAPPA = ATAN2(SINKAP,COSKAP)
KAPPA = KAPPA*180.0/PI
C
C---- If kappa negative, negate kappa and invert DIRCOS
C
IF (KAPPA.LT.0.0) THEN
KAPPA = -KAPPA
DIRCOS(1) = -DIRCOS(1)
DIRCOS(2) = -DIRCOS(2)
DIRCOS(3) = -DIRCOS(3)
END IF
C
C---- Format statements
C
6000 FORMAT (' All P()s. are negative or zero')
C
C
END
C
C
C
C
C =====================================
SUBROUTINE LAUESY(CELL,IGROUP,NEQ,ML)
C =====================================
IMPLICIT NONE
C
C
C
C
C
C Obtain equivalent positions of laue-group from space-group number.
C The space-group number for your crystal can be looked up in the
C International tables for x-ray crystallography vol.i
C
C W.KABSCH 7-1986
C
C
C CELL - unit cell parameters in angstroem and degrees (given)
C IGROUP - space group number as obtained from the international (given)
C tables for x-ray crystallography vol.i
C NEQ - number of equivalent positions in laue group (result)
C derived from space-group number. a value of zero
C indicates an illegal space-group number or illegal
C unit cell parameters. otherwise neq assumes values
C between 1 and 24.
C ML - integer array of length at least neq*9 specified (result)
C in the main program, to describe symmetry. all
C friedel related positions are omitted. the largest
C number of neq is 24, as mentioned. therefore, the
C calling program should declare
C integer ml(216) to handle all possible cases!!!
C the operators returned by this subroutine are
C proper rotations. to obtain the complete laue-group
C you only have to add the 'neq' friedel mates to
C the matrices given by this routine. usually this is
C not wanted.
C each operator is represented by 9 consecutive
C numbers as follows:
C if x',y',z' is an equivalent position of x,y,z then
C x'=x*ml(1)+y*ml(2)+z*ml(3)
C y'=x*ml(4)+y*ml(5)+z*ml(6)
C z'=x*ml(7)+y*ml(8)+z*ml(9)
C the next operator occupies positions ml(10)...ml(18),
C and so on...
C
C
C
C
REAL CELL(6),EPS
INTEGER ML(*),NEQ,IGROUP,IG,I,J,K,L,M
INTEGER*2 MAT(288),MATN(56),NM(14),NA(14)
PARAMETER (EPS=0.001)
DATA MAT/ 1,3*0,1,3*0,1, -1,3*0,-1,3*0,1, 1,3*0,-1,3*0,-1,
1 -1,3*0,1,3*0,-1, 0,1,0,-1,4*0,1, 0,-1,0,1,4*0,1,
2 0,-1,0,-1,4*0,-1, 0,1,0,1,4*0,-1, 0,0,1,1,3*0,1,0,
3 0,0,1,-1,3*0,-1,0, 0,1,3*0,1,1,0,0, 0,1,3*0,-1,-1,0,0,
4 0,0,-1,1,3*0,-1,0, 0,0,-1,-1,3*0,1,0, 0,-1,3*0,1,-1,0,0,
5 0,-1,3*0,-1,1,0,0, -1,4*0,-1,0,-1,0, 0,0,-1,0,-1,0,-1,0,0,
6 -1,4*0,1,0,1,0, 0,0,-1,0,1,0,1,0,0, 1,4*0,-1,0,1,0,
7 0,0,1,0,-1,0,1,0,0, 1,4*0,1,0,-1,0, 0,0,1,0,1,0,-1,0,0,
8 0,-1,0,1,-1,3*0,1, -1,1,0,-1,4*0,1, -1,0,0,-1,1,3*0,-1,
9 1,-1,0,0,-1,3*0,-1, 0,1,0,-1,1,3*0,1, 1,-1,0,1,4*0,1,
$ 1,0,0,1,-1,3*0,-1, -1,1,0,0,1,3*0,-1/
DATA MATN/1,4,3,2,9,10,11,12,13,14,15,16,
1 5,6,7,8,17,18,19,20,21,22,23,24,
2 1,2,5,6,3,4,7,8,
3 1,25,26,8,27,28, 1,9,11,7,17,18,
4 1,25,26,2,29,30, 7,31,32,8,27,28/
DATA NM/ 1,2,4,12,24, 2,4,8, 3,6, 3,6, 6,12/
DATA NA/ 0,0,0,0,0, 24,24,24, 32,32, 38,38, 44,44/
C
C
C
C---- check unit cell parameters
C
IG=0
NEQ=0
DO 10 J=1,6
IF (CELL(J).LE.0.0)GO TO 30
10 CONTINUE
C
C---- find laue group from space-group number and unit cell parameters
C
C ..... triclinic axes
C
IF ((IGROUP.GT.0).AND.(IGROUP.LT.3))IG=1
C
C ..... monoclinic axes
C
IF ((IGROUP.GT.2).AND.(IGROUP.LT.16).AND.
@ (ABS(CELL(4)-90.0).LT.EPS))THEN
IF (ABS(CELL(5)-90.0).LT.EPS)IG=6
IF (ABS(CELL(6)-90.0).LT.EPS)IG=2
ENDIF
C
C ..... orthorhombic axes
C
IF ((ABS(CELL(4)-90.0).LT.EPS).AND.(ABS(CELL(5)-90.0).LT.EPS)
@ .AND.(ABS(CELL(6)-90.0).LT.EPS))THEN
IF ((IGROUP.GT.15).AND.(IGROUP.LT.75))IG=3
C
C ..... tetragonal axes
C
IF (ABS(CELL(1)-CELL(2)).LT.EPS)THEN
IF ((IGROUP.GT.74).AND.(IGROUP.LT.89))IG=7
IF ((IGROUP.GT.88).AND.(IGROUP.LT.143))IG=8
C
C ..... cubic axes
C
IF (ABS(CELL(1)-CELL(3)).LT.EPS)THEN
IF ((IGROUP.GT.194).AND.(IGROUP.LT.207))IG=4
IF ((IGROUP.GT.206).AND.(IGROUP.LT.231))IG=5
ENDIF
ENDIF
ENDIF
C
C ..... hexagonal axes
C
IF ((ABS(CELL(1)-CELL(2)).LT.EPS).AND.(ABS(CELL(4)-90.0).LT.EPS)
@ .AND.(ABS(CELL(5)-90.0).LT.EPS).AND.(ABS(CELL(6)-120.0).LT.EPS))
& THEN
IF ((IGROUP.GT.142).AND.(IGROUP.LT.149))IG=9
IF ((IGROUP.GT.148).AND.(IGROUP.LT.168))IG=10
IF ((IGROUP.GT.167).AND.(IGROUP.LT.177))IG=13
IF ((IGROUP.GT.176).AND.(IGROUP.LT.195))IG=14
ENDIF
C
C ..... rhombohedral axes
C
IF ((ABS(CELL(1)-CELL(2)).LT.EPS).AND.
1 (ABS(CELL(1)-CELL(3)).LT.EPS).AND.
2 (ABS(CELL(4)-CELL(5)).LT.EPS).AND.
3 (ABS(CELL(4)-CELL(6)).LT.EPS))THEN
IF ((IGROUP.EQ.146).OR.(IGROUP.EQ.148))IG=11
IF ((IGROUP.EQ.155).OR.(IGROUP.EQ.160).OR.(IGROUP.EQ.161).OR.
@ (IGROUP.EQ.166).OR.(IGROUP.EQ.167))IG=12
ENDIF
C
C---- get matrices of equivalent positions for laue group
C
IF (IG.LT.1)GO TO 30
NEQ=NM(IG)
K=NA(IG)
I=0
DO 20 J=1,NEQ
L=9*(MATN(J+K)-1)
DO 20 M=1,9
I=I+1
20 ML(I)=MAT(M+L)
30 RETURN
END
C
C
C
C ========================
SUBROUTINE RFMATMUL(A,B,C)
C ========================
IMPLICIT NONE
C
C
REAL A(3,3),B(3,3),C(3,3)
INTEGER I,J
C
C
DO 1 I=1,3
DO 1 J=1,3
1 C(I,J)=A(I,1)*B(1,J)+A(I,2)*B(2,J)+A(I,3)*B(3,J)
RETURN
END
C
C
C
C ============================
SUBROUTINE ORDR3(KNTRL,Q,NQ)
C ============================
IMPLICIT NONE
C
C
C
C Find NQ(1) so that |Q(NQ(1)| is biggest Q.
C If KNTRL=1, make NQ(1),NQ(2),NQ(3) a positive permutn.
C If KNTRL= anything else,
C find nos. NQ() so that|Q(NQ(1)|>|Q(NQ(2))|>|Q(NQ(3))|
C
C
C
C
C
C---- Find no. NQ(1) of Q() with largest |Q()|.
C
C .. Scalar Arguments ..
INTEGER KNTRL
C ..
C .. Array Arguments ..
REAL Q(3)
INTEGER NQ(3)
C ..
C .. Local Scalars ..
INTEGER J
C ..
C .. Intrinsic Functions ..
INTRINSIC ABS,MOD
C ..
SAVE
C
C
NQ(1) = 1
IF (ABS(Q(2)).GT.ABS(Q(1))) NQ(1) = 2
IF (ABS(Q(3)).GT.ABS(Q(NQ(1)))) NQ(1) = 3
C
C---- Find nos. for other two Q()'s & order so |Q(NQ(2))|>|Q(NQ(3))|
C
NQ(2) = MOD(NQ(1),3) + 1
NQ(3) = MOD(NQ(2),3) + 1
IF (KNTRL.NE.1) THEN
C
C
IF (ABS(Q(NQ(3))).GT.ABS(Q(NQ(2)))) THEN
J = NQ(3)
NQ(3) = NQ(2)
NQ(2) = J
END IF
END IF
RETURN
C
C
END