C LAST UPDATE: C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C************************** C** LFN_SOFT ** C************************** C CD-Routine: Find Improved Soft Limit - LFN_SOFT C This routine determines an improved value for the 'dmin' or 'lambda-min' C soft limits used in the processing of Laue data. The method involves C over predicting the data, measuring integrated intensities and examining C the statistics of the integrated intensities as a function of resolution C or wavelength respectively. A preferred value is returned by the routine C as well as the statistical data which may be further examined. CD-end CD-Fortran: SUBROUTINE LFN_SOFT (IPACK, IPLATE, IOPT, IMG, ITYPE, IORDER, + NF_OFF, NAX1_RASTS, NAX2_RASTS, PROMIN, + NTHE, PROF_ROT, PROGRESS, CANCEL, + FRAC, SIGTEST, FRTEST, NUMBINS, BIN_WIDTH, + NTOT_MEAS, NTOT_GTSIG, NMEAS, NGTSIG, RBIN, + SOFT_MIN, SOFT_MAX, SOFT_SEL, IBIN_SEL, + IERR, ERRSTR, IWARN, WARNSTR) CD-end C INCLUDE 'implicit_none.finc' C C Purpose: Determine soft limit C C Author: Q. Hao, J. W. Campbell, March 1994 C C Arguments: C INTEGER IPACK INTEGER IPLATE INTEGER IOPT INTEGER IMG(*) INTEGER ITYPE INTEGER IORDER INTEGER NF_OFF INTEGER NAX1_RASTS INTEGER NAX2_RASTS REAL PROMIN INTEGER NTHE LOGICAL PROF_ROT EXTERNAL PROGRESS LOGICAL CANCEL EXTERNAL CANCEL REAL FRAC REAL SIGTEST REAL FRTEST INTEGER NUMBINS REAL BIN_WIDTH INTEGER NTOT_MEAS INTEGER NTOT_GTSIG INTEGER NMEAS(NUMBINS) INTEGER NGTSIG(NUMBINS) REAL RBIN(NUMBINS) REAL SOFT_MIN REAL SOFT_MAX REAL SOFT_SEL INTEGER IBIN_SEL INTEGER IERR CHARACTER*(*) ERRSTR INTEGER IWARN CHARACTER*(*) WARNSTR CD-Parameters: C IPACK i (R) Pack number C IPLATE i (R) Plate number C IOPT i (R) Option =1 Dmin soft limit determination C =2 Lambda-min soft limit determination C IMG (*) i (R) Image data array (may hold signed integer data or C unsigned byte data packed into an integer array or C unsigned two byte data packed into an integer array C or squashed i2 data packed into an integer array C ITYPE i (R) Image data type =1 unsigned byte C =2 unsigned two byte C =3 signed (full) integer C =4 squashed i2 data C IORDER i (R) Order of data in image wrt. the two local axes C =1 +ax1 +ax2 C =2 +ax1 -ax2 C =3 -ax1 +ax2 C =4 -ax1 -ax2 C =5 +ax2 +ax1 C =6 +ax2 -ax1 C =7 -ax2 +ax1 C =8 -ax2 -ax1 C NF_OFF i (R) Fast offset between (slow) rasters of image (e.g. 1'st C dimension of the image data if the data are held in C a two dimensional array). This value is the number C of elements for the image data type (bytes, 2-bytes C or integers as set by ITYPE) C NAX1_RASTS i (R) No. of rasters in the image along the first C local axis C NAX2_RASTS i (R) No. of rasters in the image along the second C local axis C PROMIN r (R) Minimum intensity to include in profile determination C e.g. 100 for film, 600 for image plate C NTHE i (R) Number of theta bins for profile fitting (e.g. 8, C max=17 unless program limit was reset) C PROF_ROT l (R) Rotate profiles for elliptical spots integrattion C flag C PROGRESS ( ) Subroutine which will be called at intervals during C the integration which may be used to display its C progress if required (See below for its arguments). C If not required, the dummy routine LFN_SOFT_PROG C may be passed. Note that the routine must be C declared as EXTERNAL in the calling program. C CANCEL f (R) Logical function used to interrupt procedure C It has one dummy argument and must return a C logical value of .TRUE. to cancel the procedure C or .FALSE. to let it proceed. C The actual function passed must be declared as C both LOGICAL and EXTERNAL in the calling program. C (The dummy function LFN_DUMMY_CNCL may be used) C FRAC r (R) Fraction of current soft limit for use in reflection C generation (suggested value = 0.8) C SIGTEST r (R) No. of sigmas to be used for determining significant C intensities for statistics (suggested value = 5.0) C FRTEST r (R) Fraction for population of significant reflections C just above soft limit (suggested value = 0.15) C NUMBINS i (R) Number of bins to use (suggested value = 20) C BIN_WIDTH r (R) Width of soft limit bins (suggest 0.02 if current C value <=0.5, 0.05 if >0.5 and <= 1.0 and 0.1 if > 1.0 C NTOT_MEAS i (W) Total number of measured spots C NTOT_GTSIG i (W) Total number of significant spots C NMEAS(*) i (W) Number of measured spots in each bin (dimensioned C to at least NUMBINS) C NGTSIG(*) i (W) Number of significant spots in each bin (dimensioned C to at least NUMBINS) C RBIN(*) r (W) Ratios of significant to measured spots in each bin C (dimensioned to at least NUMBINS) C SOFT_MIN r (W) Soft limit minimum used (rounded down to nearest C bin_width multiple value) C SOFT_MAX r (W) Soft limit maximum used C SOFT_SEL r (W) Selected value for the soft limit C IBIN_SEL i (W) Selected bin number (just above selected soft limit) C IERR i (W) Error flag = 0, OK C = -1, Invalid pack number C = -2, Invalid plate number C = -3, Invalid image type or order flag C = -4, Byte handling not available C = 1, Box size required based on spot size C exceeds current program limits C = 2, Too many bins requested for profile C fitting C = 3, Less than 2 bins requested for C statistics C = 100 Procedure interrupted C ERRSTR c (W) Error message string (max 80 chars) set if IERR is C non-zero C IWARN i (W) Warning flag = 0 OK (provided IERR = 0) C = 1 No bin has 10 or more significant C reflections C = 2 First bin selected; soft limit needs C to be determined with a lower start C value C = 3 Less than five significant reflection C in selected 'above soft limit' bin C WARNSTR c (W) Warning message string if IWARN is non-zero C C C Subroutine PROGRESS (IPASS, NSPOT, ISPOT) C C This routine is passed on to the integration routine C LFN_SAINT which will call it with the following C parameters:- C C IPASS i (R) Integration pass = 0 box integration, C = 1 get profiles, C = 2 profile fitted C integration C NSPOT i (R) No. of spots to be integrated C ISPOT i (W) Last spot integrated CD-end C====== Parameter statements C C C====== GLOBALS: C C C====== FUNCTION TYPES: C C C====== LOCALS: C LOGICAL NODF LOGICAL SPAT LOGICAL BAD LOGICAL OVL LOGICAL MS INTEGER I INTEGER N INTEGER IFLAG INTEGER ND INTEGER NTOT_SPOTS INTEGER IH INTEGER IK INTEGER IL INTEGER MULT INTEGER JERR INTEGER ICODE INTEGER ICT INTEGER IBIN REAL DMIN_SAV REAL LMIN_SAV REAL XF REAL YF REAL AI REAL ASIG REAL BLAM REAL DTHR REAL X REAL RBINMAX CHARACTER*2 ERR2 C LOGICAL NODF !OK nodal flag C LOGICAL SPAT !Spatial overlap flag C LOGICAL BAD !Bad spot flag C LOGICAL OVL !Overload spot flag C LOGICAL MS !Spot measured flag C INTEGER I !Temp/loop variable C INTEGER N !Temp/loop variable C INTEGER IFLAG !Flag from LDM routines C INTEGER ND !No. of decimal places from LDM routines C INTEGER NTOT_SPOTS !Total no. of spots generated C INTEGER IH !'h' index C INTEGER IK !'k' index C INTEGER IL !'l' index C INTEGER MULT !Multiplicity C INTEGER JERR !Error flag C INTEGER ICODE !Integration code C INTEGER ICT !Integration code type flag C INTEGER IBIN !Bin number C REAL DMIN_SAV !Saves original dmin C REAL LMIN_SAV !Saves original lambda-min C REAL XF !Spot xf position C REAL YF !Spot yf position C REAL AI !Spot intensity C REAL ASIG !Spot sigma(Intensity) C REAL BLAM !Spot lambda C REAL DTHR !Spot dmin threshold sq. C REAL X !Soft limit parameter value of current spot C REAL RBINMAX !Maximum bin significant/measured ratio C CHARACTER*2 ERR2 !Dummy error string C C------------------------------------------------------------------------------- C C====== Initialisations C IERR = 0 ERRSTR = ' ' IWARN = 0 WARNSTR = ' ' SOFT_SEL = 0.0 SOFT_MIN = 0.0 SOFT_MAX = 0.0 IBIN_SEL = 0 NTOT_MEAS = 0 NTOT_GTSIG = 0 IF (NUMBINS.LT.2) THEN IERR = 3 ERRSTR = 'Less than 2 bins specified' RETURN END IF DO 10 I = 1, NUMBINS NMEAS(I) = 0 NGTSIG(I) = 0 RBIN(I) = 0.0 10 CONTINUE C C====== Get low soft limit value C IF (IOPT.EQ.1) THEN CALL LDM_GET_DMIN (IPACK, DMIN_SAV, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN SOFT_MIN = FRAC*DMIN_SAV ELSE CALL LDM_GET_LMIN (IPACK, LMIN_SAV, IFLAG, ND, IERR, ERRSTR) IF (IERR.NE.0) RETURN SOFT_MIN = FRAC*LMIN_SAV END IF SOFT_MIN = INT(SOFT_MIN/BIN_WIDTH)*BIN_WIDTH SOFT_MAX = SOFT_MIN + NUMBINS*BIN_WIDTH IF (IOPT.EQ.1) THEN CALL LDM_SET_DMIN (IPACK, SOFT_MIN, IERR, ERRSTR) IF (IERR.NE.0) GO TO 800 ELSE CALL LDM_SET_LMIN (IPACK, SOFT_MIN, IERR, ERRSTR) IF (IERR.NE.0) GO TO 800 END IF C C====== Generate reflections & store C CALL LRL_GEN (IPACK, IPLATE, .TRUE., 2, IERR, ERRSTR) IF (IERR.NE.0) GO TO 800 C C====== Sort on slowest moving index in image array C IF (IORDER.LE.4) THEN CALL LRL_SORT (3) ELSE CALL LRL_SORT (4) END IF C C====== Integrate C CALL LFN_SAINT (IPACK, IPLATE, 1, IMG, ITYPE, IORDER, + NF_OFF, NAX1_RASTS, NAX2_RASTS, PROMIN, + NTHE, PROF_ROT, 0, PROGRESS, CANCEL, + IERR, ERRSTR) IF (IERR.NE.0) GO TO 800 CALL LFN_SAINT (IPACK, IPLATE, 2, IMG, ITYPE, IORDER, + NF_OFF, NAX1_RASTS, NAX2_RASTS, PROMIN, + NTHE, PROF_ROT, 0, PROGRESS, CANCEL, + IERR, ERRSTR) IF (IERR.NE.0) GO TO 800 C C====== Accumulate Statistics C CALL LRL_NUMSPOTS(NTOT_SPOTS) IF (NTOT_SPOTS.LT.1) GO TO 800 DO 200 N = 1, NTOT_SPOTS CALL LRL_GET (N, IH, IK, IL, XF, YF, BLAM, DTHR, MULT, + NODF, SPAT, JERR) IF (MULT.EQ.1.AND..NOT.SPAT) THEN CALL LRL_GET_INT (N, AI, ASIG, MS, BAD, OVL, ICODE, ICT, + JERR) IF (IOPT.EQ.1) THEN X = 1.0/SQRT(DTHR) ELSE X = BLAM END IF IF (X.LT.SOFT_MIN.OR.X.GT.SOFT_MAX) GO TO 200 IBIN = NUMBINS*(X-SOFT_MIN)/(SOFT_MAX-SOFT_MIN) + 1 IF (IBIN.LT.1) IBIN = 1 IF (IBIN.GT.NUMBINS) IBIN = NUMBINS NMEAS(IBIN) = NMEAS(IBIN) + 1 NTOT_MEAS = NTOT_MEAS + 1 IF (AI.GT.SIGTEST*ASIG) THEN NGTSIG(IBIN) = NGTSIG(IBIN) + 1 NTOT_GTSIG = NTOT_GTSIG + 1 END IF END IF IF (CANCEL(0)) THEN IERR = 100 ERRSTR = 'Procedure interrupted' RETURN END IF 200 CONTINUE C C====== Get ratios C RBINMAX = 0.0 DO 220 I = 1, NUMBINS IF (NMEAS(I).GT.0) THEN RBIN(I) = FLOAT(NGTSIG(I))/FLOAT(NMEAS(I)) ELSE RBIN(I) = 0.0 END IF IF (RBIN(I).GT.RBINMAX.AND.NGTSIG(I).GE.10) RBINMAX = RBIN(I) 220 CONTINUE IF (RBINMAX.EQ.0.0) THEN IWARN = 1 WARNSTR = 'No bin has 10 or more significant spots' GO TO 800 END IF IF (CANCEL(0)) THEN IERR = 100 ERRSTR = 'Procedure interrupted' RETURN END IF C C====== Find soft limit value C DO 250 I = 1, NUMBINS IBIN = I IF (RBIN(I)/RBINMAX.GE.FRTEST) GO TO 280 250 CONTINUE 280 SOFT_SEL = SOFT_MIN + (IBIN-1)*(SOFT_MAX-SOFT_MIN)/NUMBINS IBIN_SEL = IBIN IF (IBIN_SEL.EQ.1) THEN IWARN = 2 WARNSTR = 'Need to retry with lower start limit' END IF IF (NGTSIG(IBIN).LT.5) THEN IWARN = 3 WARNSTR = 'Selected bin has < 5 significant spots' GO TO 800 END IF IF (CANCEL(0)) THEN IERR = 100 ERRSTR = 'Procedure interrupted' RETURN END IF C C====== Reset limits C 800 IF (IOPT.EQ.1) THEN CALL LDM_SET_DMIN (IPACK, DMIN_SAV, JERR, ERR2) ELSE CALL LDM_SET_LMIN (IPACK, LMIN_SAV, JERR, ERR2) END IF RETURN END