C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**   Program 'intldm'      **
C*****************************
C
C Purpose: LDM compatible integration program (using Hao Quan's integration
C          routines)
C                            
C Author:  John W. Campbell, November 1995
C
C Program uses the Laue Data Module [LDM], the Laue Reflection List [LRL]
C and associated routines and the Laue Intensity Reflection List [LIRL]
C routines.
C
C====== Implicit none
C
      INCLUDE 'implicit_none.finc'
C
C====== Parameter statements
C
      INCLUDE 'ldm_limits.finc'
      INCLUDE 'ldm_prog_flags.finc'
C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      INTEGER XDLSTR
      INTEGER LENSTR
      EXTERNAL LFN_SOFT_PROG
      LOGICAL LFN_DUMMY_CNCL
      EXTERNAL LFN_DUMMY_CNCL
      LOGICAL CCPONL
      LOGICAL CCPEXS
      INTEGER IARGC
      INTEGER LDM_INTFP
      LOGICAL VAXVMS
      EXTERNAL VAXVMS
C
C====== LOCALS:
C
      LOGICAL ONL
      LOGICAL EXISTS
      LOGICAL OVERWRITE
      LOGICAL QUIT
      LOGICAL OKNOD
      LOGICAL SPOV
      LOGICAL CLOS
      LOGICAL MEAS
      LOGICAL BAD
      LOGICAL OVLD
      LOGICAL DISTOR
      LOGICAL RESCALE
      LOGICAL RSC
      LOGICAL PROF_ALL
      LOGICAL SORT_OK
      LOGICAL PROF_ROT
      INTEGER I
      INTEGER II
      INTEGER NARG
      INTEGER LL
      INTEGER IERR
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IPACK_MIN
      INTEGER IPACK_MAX
      INTEGER KPACK
      INTEGER KEYPLATE
      INTEGER IPP
      INTEGER KDX
      INTEGER IUN_KDM
      INTEGER IUN_IN
      INTEGER IUN_OUT
      INTEGER IUN_LDM
      INTEGER IUN_LOG
      INTEGER IUN_DIAG
      INTEGER IUN_GE1
      INTEGER IUN_GE2
      INTEGER IUN_PRINT
      INTEGER IFLAG
      INTEGER ND
      INTEGER IORD
      INTEGER ISWAP
      INTEGER MINVAL
      INTEGER MAXVAL
      INTEGER IFD
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NFRASTS
      INTEGER NP
      INTEGER NUMPACKS
      INTEGER NPLATES
      INTEGER NTHE
      INTEGER KORD
      INTEGER NBW
      INTEGER IFTYPE
      INTEGER ITYPE
      INTEGER IOUT_TYPE
      INTEGER MINDX
      INTEGER IFAIL
      INTEGER IV
      INTEGER NUMSPOTS
      INTEGER NUMREFL
      INTEGER NUMSING
      INTEGER NUMMULT
      INTEGER NUMSPAT
      INTEGER NUMCLOS
      INTEGER ISPOT
      INTEGER IPK
      INTEGER IPL
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER IH_N
      INTEGER IK_N
      INTEGER IL_N
      INTEGER MULT
      INTEGER MINHARM
      INTEGER MAXHARM
      INTEGER INCHARM
      INTEGER ICODE
      INTEGER ICODE_TYPE
      INTEGER ISPAT
      INTEGER ICLOS
      INTEGER IMEAS
      INTEGER IBAD
      INTEGER IOVLD
      INTEGER IPACK_ID
      INTEGER KSYM
      INTEGER IRFL
      INTEGER NOTDONE
      INTEGER NUM_SPOTS
      INTEGER NUM_MULTIPLETS
      INTEGER NUM_SPATIALS
      INTEGER NUM_BOTH
      INTEGER NUM_NODALS
      INTEGER LAMBDA_BINS(16)
      INTEGER ISORT(5)
      INTEGER IMG (MAX_IMG_WORDS)
      INTEGER KEY_LOG
      INTEGER NS(5)
      INTEGER NG(5)
      INTEGER NO(5)
      INTEGER NN(5)
      INTEGER NB(5)
      INTEGER N3(5)
      INTEGER N10(5)
      INTEGER NUMREFS
      INTEGER NOV
      INTEGER NOVLD
      REAL AIM(5)
      REAL AIS(5)
      REAL FP
      REAL PROMIN
      REAL XD
      REAL YD
      REAL XFD
      REAL YFD
      REAL ALAM
      REAL DMTHR2
      REAL ALNOD
      REAL DTHR2NOD
      REAL AI
      REAL SIGI
      REAL SCAL
      REAL SCALOUT
      REAL CELL(6)
      REAL ADATA(15)
      CHARACTER*10 VERSTR
      CHARACTER*8 DATSTR
      CHARACTER*8 TIMSTR
      CHARACTER*80 HEADER
      CHARACTER*120 ERRSTR
      CHARACTER*120 STR
      CHARACTER*50 VALSTR
      CHARACTER*80 TITL
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) PAR_FILE
      CHARACTER*(MAXFLEN) DIAGFIL
      CHARACTER*(MAXFLEN) TEMPLATE
      CHARACTER*(MAXFLEN) IMGFIL
      CHARACTER*(MAXFLEN) GE1_FILE
      CHARACTER*(MAXFLEN) GE2_FILE
      CHARACTER*(MAXFLEN) MTZ_FILE
      CHARACTER*(MAXFLEN) TMPFIL
      CHARACTER*(MAXFLEN) LOG_FILE
      CHARACTER*80 HSTRNG(2)
      CHARACTER*30 LABLS(15)
      CHARACTER*1 CTYPS(15)

C     LOGICAL ONL                  !Program is being run in on-line mode flag
C     LOGICAL EXISTS               !File exists flag
C     LOGICAL OVERWRITE            !Overwrite existing file flag
C     LOGICAL QUIT                 !Program quit flag
C     LOGICAL OKNOD                !Non-overlapped nodal flag
C     LOGICAL SPOV                 !Spatial overlap flag
C     LOGICAL CLOS                 !Spot too close to integrated flag
C     LOGICAL MEAS                 !Intensity measured flag
C     LOGICAL BAD                  !Bad spot flag
C     LOGICAL OVLD                 !Overload flag
C     LOGICAL DISTOR               !Distortion correct coordinates flag
C     LOGICAL RESCALE              !Output intensities rescaled flag
C     LOGICAL RSC                  !One or more packs rescaled flag
C     LOGICAL PROF_ALL             !Profile fit all plates of a pack flag
C     LOGICAL SORT_OK              !Sort was OK flag
C     LOGICAL PROF_ROT             !Rotate profiles flag
C     INTEGER I                    !Temp/loop variable
C     INTEGER II                   !Temp/loop variable
C     INTEGER NARG                 !No. of command line arguments
C     INTEGER LL                   !String length 
C     INTEGER IERR                 !Error flag
C     INTEGER IPACK                !Pack number
C     INTEGER IPLATE               !Plate number
C     INTEGER IPACK_MIN            !Minimum pack no. to integrate
C     INTEGER IPACK_MAX            !Maximum pack no. to integrate
C     INTEGER KPACK                !Pack to integrate flag
C     INTEGER KEYPLATE             !Key plate no.
C     INTEGER IPP                  !Loop through keyplate then other plates
C     INTEGER KDX                  !Index for keyworded INTLDM data
C     INTEGER IUN_KDM              !Unit no. for keyworded INTLDM data
C     INTEGER IUN_IN               !Unit no. for standard input
C     INTEGER IUN_OUT              !Unit no. for standard output
C     INTEGER IUN_LDM              !Unit no. for reading LDMdata file
C     INTEGER IUN_LOG              !Unit no. for log output (0 if none)
C     INTEGER IUN_DIAG             !Unit no. for input diagnostics file 
C                                   (0 if none)
C     INTEGER IUN_GE1              !Unit no. for .ge1 file
C     INTEGER IUN_GE2              !Unit no. for .ge2 file
C     INTEGER IUN_PRINT            !save unit no. of printer stream
C     INTEGER IFLAG                !Parameter status flag
C     INTEGER ND                   !No. of decimal places flag
C     INTEGER IORD                 !Image data order flag
C     INTEGER ISWAP                !Image data byte swap flag
C     INTEGER MINVAL               !Minimum image pixel value
C     INTEGER MAXVAL               !Maximum image pixel value
C     INTEGER IFD                  !File handle for image file
C     INTEGER NXRAST               !No. of x-rasters
C     INTEGER NYRAST               !No. of y-rasters
C     INTEGER NFRASTS              !No. of fast moving index rasters
C     INTEGER NP                   !No. of pixels in image
C     INTEGER NUMPACKS             !No. of packs
C     INTEGER NPLATES              !No. of plates/pack
C     INTEGER NTHE                 !No. of theta bins for profiles
C     INTEGER KORD                 !Image order flag
C     INTEGER NBW                  !No. of bytes/word
C     INTEGER IFTYPE               !File type flag (1=byte, 2=i2_
C     INTEGER ITYPE                !Image data storage type in image array
C     INTEGER IOUT_TYPE            !Output type flag 1=mtz, 2=.ge1/.ge2
C     INTEGER MINDX                !Index to LIRL
C     INTEGER IFAIL                !File open failure flag
C     INTEGER IV                   !Integer value from LDM_GET... routines etc.
C     INTEGER NUMSPOTS             !No. of spots
C     INTEGER NUMREFL              !No. of spots predicted
C     INTEGER NUMSING              !No. of singles
C     INTEGER NUMMULT              !No. of multiples
C     INTEGER NUMSPAT              !No. of spatially overlapped spots
C     INTEGER NUMCLOS              !No. of 'too close to integtate' spots
C     INTEGER ISPOT                !Spot number
C     INTEGER IPK                  !Pack number
C     INTEGER IPL                  !Plate number
C     INTEGER IH                   !'h' index
C     INTEGER IK                   !'k' index
C     INTEGER IL                   !'l' index
C     INTEGER IH_N                 !Nodal 'h' index
C     INTEGER IK_N                 !Nodal 'k' index
C     INTEGER IL_N                 !Nodal 'l' index
C     INTEGER MULT                 !Multiplicity
C     INTEGER MINHARM              !Minimum harmonic
C     INTEGER MAXHARM              !Maximum harmonic
C     INTEGER INCHARM              !Harmonic increment
C     INTEGER ICODE                !Integration routine flags code
C     INTEGER ICODE_TYPE           !Code type of integration routines
C     INTEGER ISPAT                !Spatial overlap flag
C     INTEGER ICLOS                !Spots 'too close to integrate' flag
C     INTEGER IMEAS                !Intensity measured flag
C     INTEGER IBAD                 !Bad spot flag
C     INTEGER IOVLD                !Overload spot flag
C     INTEGER IPACK_ID             !Pack id
C     INTEGER KSYM                 !Symmetry number/flag
C     INTEGER IRFL                 !Plate refined flag
C     INTEGER NOTDONE              !No of plates for which integration not done
C     INTEGER NUM_SPOTS            !No. spot written to .ge1/.ge2 files
C     INTEGER NUM_MULTIPLETS       !No. multiples written to .ge1/.ge2 files
C     INTEGER NUM_SPATIALS         !No. spatials written to .ge1/.ge2 files
C     INTEGER NUM_BOTH             !No. both spatial & multiple
C     INTEGER NUM_NODALS           !No. nodals written to .ge1/.ge2 files
C     INTEGER LAMBDA_BINS(16)      !Lambda bins histogram
C     INTEGER ISORT(5)             !MTZ column sort flags
C     INTEGER IMG (MAX_IMG_WORDS)  !Array holding the image data
C     INTEGER KEY_LOG              !Output key to statistics flag
C     INTEGER NS(5)                !No. of spots present for the 5 spot 
C                                   categories
C     INTEGER NG(5)                !No. of spots integrated & good for 
C                                   the 5 spot categories
C     INTEGER NO(5)                !No. of overload spots flagged for 
C                                   the 5 spot categories
C     INTEGER NN(5)                !No. of OK negative intensities for
C                                   the 5 spot categories
C     INTEGER NB(5)                !No. of bad spots spots flagged for 
C                                   the 5 spot categories
C     INTEGER N3(5)                !No. OK spots with I>3*sig(I) for 
C                                   the 5 spot categories
C     INTEGER N10(5)               !No. OK spots wit I>10*sig(I) for 
C                                   the 5 spot categories
C     INTEGER NUMREFS              !No. of reflns in LIRL
C     INTEGER NOV                  !No. of overloaded pixels in a spot
C     INTEGER NOVLD                !No. of overloaded pixels to allow as OK
C     REAL AIM(5)                  !Mean I value for the 5 spot categories 
C                                   (for OK positive intensities only)
C     REAL AIS(5)                  !Mean I/sig(I) values for the 5 spot 
C                                   categories (for OK positive intensities 
C                                   only)
C     REAL FP                      !Real value from LDM_GET... routines
C     REAL PROMIN                  !Minimum intensity for inclusion in profiles
C     REAL XD                      !'x' spot position on detector (rasters)
C     REAL YD                      !'y' spot position on detector (rasters)
C     REAL XFD                     !'x' coordinate value for spot (mm)
C     REAL YFD                     !'y' coordinate value for spot (mm)
C     REAL ALAM                    !Lambda value
C     REAL DMTHR2                  !Dmin-threshold**2
C     REAL ALNOD                   !Nodal lambda value
C     REAL DTHR2NOD                !Nodal dmin-threshold**2 value
C     REAL AI                      !Integrated intensity
C     REAL SIGI                    !sig(AI)
C     REAL SCAL                    !Requested output intensities scale factor
C     REAL SCALOUT                 !Used o/p scale factor (.ge1/.ge2 files)
C     REAL CELL(6)                 !Real cell dimensions
C     REAL ADATA(15)               !Reflection data buffer for MTZ file
C     CHARACTER*10 VERSTR          !Program version string
C     CHARACTER*8 DATSTR           !Date string
C     CHARACTER*8 TIMSTR           !Time string
C     CHARACTER*80 HEADER          !Program header for log filee
C     CHARACTER*120 ERRSTR         !Error string
C     CHARACTER*120 STR            !Temp/message string
C     CHARACTER*50 VALSTR          !LDM parameter value string
C     CHARACTER*80 TITL            !LDM title
C     CHARACTER*(MAXFLEN) FILNAM    !File name string
C     CHARACTER*(MAXFLEN) PAR_FILE !LDM parameter file name
C     CHARACTER*(MAXFLEN) DIAGFIL  !Diagnostics requested spots file name
C     CHARACTER*(MAXFLEN) TEMPLATE !Output intensity files template
C     CHARACTER*(MAXFLEN) IMGFIL   !Image file name for current plate
C     CHARACTER*(MAXFLEN) GE1_FILE !.ge1 file name
C     CHARACTER*(MAXFLEN) GE2_FILE !.ge2 file name
C     CHARACTER*(MAXFLEN) MTZ_FILE !MTZ output file name
C     CHARACTER*(MAXFLEN) TMPFIL   !Temporary file name string
C     CHARACTER*(MAXFLEN) LOG_FILE !Log file name string
C     CHARACTER*80 HSTRNG(2)       !History string
C     CHARACTER*30 LABLS(15)       !MTZ file labels strings
C     CHARACTER*1 CTYPS(15)        !MTZ file column types flags

      DATA LABLS/'H','K','L','PACK_ID','PLATE','XF','YF','LAMBDA',
     +            'I','SIGI','MULT','MINHARM','MAXHARM','NOVPIX',
     +            'FLAGS'/
      DATA CTYPS/'H','H','H','B','I','R','R','R','J','Q','I',
     +           'I','I','R','I'/
C
C-------------------------------------------------------------------------------
C
C
C====== Set current version
C
      VERSTR = '2.0'
C
C====== Initialisations
C
      IUN_LOG = 6
      IUN_PRINT = IUN_LOG
      IUN_LDM = 2
      IUN_IN = 5
      IUN_OUT = 6
      IUN_DIAG = 0
      IUN_GE1 = 20
      IUN_GE2 = 21
      IUN_KDM = IUN_IN
      IUN_TMP = 25
      CALL TRWSET (IUN_IN, IUN_OUT, 0, 0, 0)
      ONL = .FALSE.
      CALL UISATT (IUN_IN, I)
      IF (I.EQ.1) ONL = .TRUE.
      NOTDONE = 0
      DISTOR = .FALSE.
      RSC = .FALSE.
      DIAGFIL = ' '
      KPACK = 0
      KEY_LOG = 1
      VMS = VAXVMS(0)
      OUT_SPAC = .FALSE.
C
C====== Extend LDM parameter set as for LAUEGEN
C
      CALL EXTEND_LDM
C
C====== Interpret command line arguments to see if pack number (or 'all')
C====== and/or diagnotics file specified
C
      NARG = IARGC()
      FILNAM = ' '
      IF (NARG.GT.0) THEN
         I = 0
10       I = I + 1
         IF (I.GT.NARG) GO TO 20
         CALL UGTARG (I, STR)
         CALL CCPUPC (STR)
         IF (STR(1:1).EQ.'D'.OR.STR(1:2).EQ.'-D') THEN
            IF (I.LT.NARG) THEN
               I = I + 1
               CALL UGTARG (I, FILNAM)
            END IF
         ELSE IF (STR(1:1).EQ.'B'.OR.STR(1:2).EQ.'-B') THEN
            ONL = .FALSE.
         ELSE IF (STR(1:1).EQ.'A'.OR.STR(1:2).EQ.'-A') THEN
            KPACK = 0
         ELSE
            II = LDM_INTFP (STR, FP, IV, ND)
            IF (II.EQ.1) KPACK = IV
         END IF
         GO TO 10
      END IF

 20   IF (FILNAM.NE.' ') THEN
         IUN_DIAG = 10
         CALL FILEXT (FILNAM, 'dia', DIAGFIL, I)
         STR = 'File name:'
         CALL STR_ADDS (STR, DIAGFIL, 1)
         EXISTS = CCPEXS (DIAGFIL)
         IF (.NOT.EXISTS) THEN
            ERRSTR = '**Error** Diagnostics spots file not found'
            IF (ONL) THEN
               CALL TWRITE (ERRSTR)
               CALL TWRITE (STR)
            ELSE
               CALL LOGSTR (IUN_LOG, ERRSTR, 1)
               CALL LOGSTR (IUN_LOG, STR, 1)
            END IF
            IF (ONL) IUN_LOG = 0
            GO TO 800
         END IF
         IFAIL = 1
         CALL CCPDPN (-IUN_DIAG, DIAGFIL, 'READONLY', 'F', 0, IFAIL)
         IF (IFAIL.LT.0) THEN
            ERRSTR = 
     +      '**Error in opening diagnostics spots file**'
            IF (ONL) THEN
               CALL TWRITE (ERRSTR)
               CALL TWRITE (STR)
            ELSE
               CALL LOGSTR (IUN_LOG, ERRSTR, 1)
               CALL LOGSTR (IUN_LOG, STR, 1)
            END IF
            IF (ONL) IUN_LOG = 0
            GO TO 800
         END IF
      END IF
C
C====== Read in log file name if on-line
C
      IF (ONL) THEN
 30      CALL TPROMP ('Log file name (default ext=.log): ')       
         CALL TREAD (FILNAM, QUIT)
         IF (QUIT) STOP
         IUN_LOG = 0
         IF (FILNAM.EQ.' ') GO TO 40
         CALL FILEXT (FILNAM, 'log', LOG_FILE, I)
         EXISTS = CCPEXS (LOG_FILE)
         IF (EXISTS) THEN
            CALL TWRITE ('*Log file already present*')
            OVERWRITE = .TRUE.
            CALL TASKQ ('Overwrite', OVERWRITE, QUIT)
            IF (QUIT) STOP
            IF (.NOT.OVERWRITE) GO TO 30
         END IF
         IUN_LOG = 1
         IFAIL = 1
         CALL CCPDPN (-IUN_LOG, LOG_FILE, 'UNKNOWN', 'F', 0, IFAIL)
         IF (IFAIL.LT.0) THEN
            CALL TWRITE ('**Error** Cannot open log file')
            GO TO 30
         END IF
      END IF
C
C====== Write out program header to log file if present
C====== -----------------------------------------------
C
 40   IF (VMS.AND.IUN_LOG.EQ.IUN_PRINT) OUT_SPAC = .TRUE.
      IF (IUN_LOG.GT.0) THEN
         CALL CCPDAT(DATSTR)
         CALL UTIME(TIMSTR)
         HEADER = 'INTLDM program (version'
         CALL STR_ADDS (HEADER, VERSTR, 1)
         CALL STR_ADDS (HEADER, '):     Run on', 0)
         CALL STR_ADDS (HEADER, DATSTR, 1)
         CALL STR_ADDS (HEADER, 'at',1)
         CALL STR_ADDS (HEADER, TIMSTR, 1)
         LL = LENSTR(HEADER)
         CALL LOG_HEAD (IUN_LOG, HEADER, 2)
         CALL LOGSTR (IUN_LOG, ' ', 1)
      END IF
C
C====== Read in control data if on-line
C====== -------------------------------
C   
      IF (ONL) THEN
         CALL READ_ONL_CTL (IUN_LDM, IUN_LOG, PAR_FILE, IOUT_TYPE, 
     +                      TEMPLATE, PROMIN, NTHE, PROF_ROT,
     +                      PROF_ALL, NOVLD, SCAL, KPACK)
C
C====== Read in keyworded data if off-line
C====== ----------------------------------
C
      ELSE
         CALL READ_LDM_CTL (IUN_IN, IUN_LOG, KPACK, IOUT_TYPE,  
     +                      TEMPLATE,PROMIN, NTHE, PROF_ROT,
     +                      PROF_ALL, NOVLD, SCAL) 
      END IF
C
C====== Write out integration control parameters
C
      STR = 'Output integrated intensities files are of type:'
      IF (IOUT_TYPE.EQ.1) THEN
         CALL STR_ADDS (STR, '.mtz', 1)
      ELSE IF (IOUT_TYPE.EQ.2) THEN
         CALL STR_ADDS (STR, '.ge1/.ge2', 1)
      END IF
      CALL LOGSTR (IUN_LOG, STR, 1)

      STR = 'Name template for output files:'
      CALL STR_ADDS (STR, TEMPLATE, 1)
      CALL LOGSTR (IUN_LOG, STR, 1)

      STR = 'Number of bins for collecting profiles:'
      CALL STR_ADDI (STR, NTHE, 1)
      CALL LOGSTR (IUN_LOG, STR, 1)

      IF (PROF_ROT) THEN
         STR = 'Profiles rotated for elliptical spots'
      ELSE
         STR = 'Profiles not rotated'
      END IF
      CALL LOGSTR (IUN_LOG, STR, 1)

      STR = 'Minimum intensity for inclusion in profiles:'
      CALL STR_ADDF (STR, PROMIN, 1, 1)
      CALL LOGSTR (IUN_LOG, STR, 1)

      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (NPLATES.GT.1) THEN
         IF (PROF_ALL) THEN
            CALL LOGSTR (IUN_LOG, 
     +        'Form profiles for each plate in pack', 1)
         ELSE
            CALL LOGSTR (IUN_LOG,
     +        'Form profiles for key plate of pack only', 1)
         END IF
      END IF

      STR = 'Number of overload pixels allowed in a spot:'
      CALL STR_ADDI (STR, NOVLD, 1)
      CALL LOGSTR (IUN_LOG, STR, 1)

      STR = 'Scale for output intensities:'
      CALL STR_ADDF (STR, SCAL, 4, 1)
      CALL LOGSTR (IUN_LOG, STR, 1)

      IF (KPACK.EQ.0) THEN
         CALL LOGSTR (IUN_LOG, 'Integrate all packs', 1)
      ELSE
         STR = 'Integrate pack'
         CALL STR_ADDI (STR, KPACK, 1)
         CALL LOGSTR (IUN_LOG, STR, 1)
      END IF

      IF (IUN_DIAG.GT.0) THEN
         STR = 'Name of diagnostics requested spots file:'
         CALL STR_ADDS (STR, DIAGFIL, 1)
         CALL LOGSTR (IUN_LOG, STR, 1)
      END IF
C
C====== Integrate required pack(s)
C====== --------------------------
C
      CALL LOG_HEAD (IUN_LOG, 'Integrate Laue Data', 3)
      CALL LDM_GET_TITLE (TITL, IFLAG)

      CALL LDM_GET_NUMP (NUMPACKS, IFLAG)
      IF (KPACK.EQ.0) THEN
         IPACK_MIN = 1
         IPACK_MAX = NUMPACKS
      ELSE
         IF (KPACK.LT.1.OR.KPACK.GT.NUMPACKS) THEN
            CALL TWRITE ('**Error** Invalid pack no. requested')
            GO TO 800
         END IF
         IPACK_MIN = KPACK
         IPACK_MAX = KPACK
      END IF
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      CALL LDM_GET_AXORD (VALSTR, IORD, ISWAP, IFLAG)
      KORD = 1
      IF (ISWAP.EQ.1) KORD = -1
      CALL LDM_GET_IMDAT (VALSTR, IFTYPE, IFLAG)
      ITYPE = 1
      IF (IFTYPE.NE.1) ITYPE = 2
      CALL LDM_GET_NXRAS (NXRAST, IFLAG)
      CALL LDM_GET_NYRAS (NYRAST, IFLAG)
      NP = NXRAST*NYRAST
      IF (IORD.LT.5) THEN      
         NFRASTS = NYRAST
      ELSE
         NFRASTS = NXRAST
      END IF
      CALL UBYTES (NBW, STR)
      IF (ITYPE.EQ.1) THEN
         IF ((NP+NBW-1)/NBW.GT.MAX_IMG_WORDS) THEN
            ERRSTR = '**Error** Image too big for program'
            STR = 'Maximum no. of words for image ='
            CALL STR_ADDI (STR, MAX_IMG_WORDS, 1)
            IF (ONL) THEN
               CALL TWRITE (ERRSTR)
               CALL TWRITE (STR)
            END IF
            CALL LOGSTR (IUN_LOG, ERRSTR, 1)
            CALL LOGSTR (IUN_LOG, STR, 1)
            GO TO 800
         END IF
      ELSE IF (ITYPE.EQ.2) THEN
         IF ((NP+NBW/2-1)/(NBW/2).GT.MAX_IMG_WORDS) THEN
            ERRSTR = '**Error** Image too big for program'
            STR = 'Maximum no. of words for image ='
            CALL STR_ADDI (STR, MAX_IMG_WORDS, 1)
            IF (ONL) THEN
               CALL TWRITE (ERRSTR)
               CALL TWRITE (STR)
            END IF
            CALL LOGSTR (IUN_LOG, ERRSTR, 1)
            CALL LOGSTR (IUN_LOG, STR, 1)
            GO TO 800
         END IF
      END IF
C
C====== Loop through Packs and plates to be integrated
C====== ----------------------------------------------
C
      DO 2500 IPACK = IPACK_MIN, IPACK_MAX
         CALL LIRLF_INIT (1000, 1000, 0, 0, MINDX)
         IF (MINDX.LT.0) THEN
            ERRSTR = '**Error** cannot allocate memory for internal'//
     +               ' reflections list'
            IF (ONL) CALL TWRITE (ERRSTR)
            CALL LOGSTR (IUN_LOG, ERRSTR, 1)
            GO TO 800
         END IF
         CALL LDM_GET_PID (IPACK, IPACK_ID, IFLAG, IERR, ERRSTR) 
         CALL LDM_GET_KEYP (IPACK, KEYPLATE, IFLAG, IERR, ERRSTR)
         IF (KEYPLATE.NE.1) THEN
            STR = 'Note: Integrating key plate ('
            CALL STR_ADDI(STR, KEYPLATE, 0)
            CALL STR_ADDS (STR, ') first', 0)
            IF (ONL) CALL TWRITE(STR)
            CALL LOGSTR (IUN_LOG, STR, 1)
         END IF
         DO 2100 IPP = 1, 2
            DO 2000 IPLATE = 1, NPLATES
               IF (IPP.EQ.1.AND.IPLATE.NE.KEYPLATE) GO TO 2000
               IF (IPP.EQ.2.AND.IPLATE.EQ.KEYPLATE) GO TO 2000
               IF (ONL) THEN
                  STR = '===Integration for pack'
                  CALL STR_ADDI (STR, IPACK, 1)
                  CALL STR_ADDS (STR, ', plate', 0)
                  CALL STR_ADDI (STR, IPLATE, 1)
                  CALL STR_ADDS (STR, '===', 0)
                  CALL TWRITE (STR)
               END IF
               STR = 'Integration for pack'
               CALL STR_ADDI (STR, IPACK, 1)
               CALL STR_ADDS (STR, ', plate', 0)
               CALL STR_ADDI (STR, IPLATE, 1)
               CALL LOG_HEAD (IUN_LOG, STR, 2)
               CALL LDM_GET_RFL (IPACK, IPLATE, IRFL, IFLAG, 
     +                           IERR, ERRSTR)
               IF (IRFL.EQ.0) THEN
                  NOTDONE = NOTDONE + 1
                  ERRSTR = '**Error** Plate not refined'
                  IF (ONL) CALL TWRITE (ERRSTR)
                  CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                  GO TO 2000
               END IF
C
C====== Generate reflections & store
C
               IF (ONL) CALL TWRITE('===Generating reflection list===')
               CALL LRL_GEN (IPACK, IPLATE, DISTOR, 2, IERR, ERRSTR)
               IF (IERR.NE.0) THEN
                  IF (ONL) CALL TWRITE (ERRSTR)
                  CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                  GO TO 800
               END IF
               CALL LRL_COUNTS (NUMSPOTS, NUMREFL, NUMSING, NUMMULT,
     +                          NUMSPAT, NUMCLOS)
               STR = 'Number of spots ='
               CALL STR_ADDI (STR, NUMSPOTS, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 1)
               STR = 'Number of reflections ='
               CALL STR_ADDI (STR, NUMREFL, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 0)
               STR = 'Number of singles ='
               CALL STR_ADDI (STR, NUMSING, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 0)
               STR = 'Number of multiples ='
               CALL STR_ADDI (STR, NUMMULT, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 0)
               STR = 'Number spatially overlapped ='
               CALL STR_ADDI (STR, NUMSPAT, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 0)
               STR = 'Number too close to integrate ='
               CALL STR_ADDI (STR, NUMCLOS, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 0)
               IF (NUMSPOTS.EQ.0) GO TO 2000
C 
C====== Sort on slowest moving index in input image
C
               IF (IORD.LE.4) THEN
                  CALL LRL_SORT (3)
               ELSE
                  CALL LRL_SORT (4)
               END IF
C
C====== Get input file name & read image
C
               CALL LDM_FILENAME (IPACK, IPLATE, IMGFIL)
               TMPFIL = IMGFIL
               CALL CCPUPC (TMPFIL)
               IF (TMPFIL.EQ.'MISSING') THEN
                  IF (IPLATE.EQ.KEYPLATE) THEN
                     ERRSTR = 
     +                 '**Error** Image file missing for key plate'
                     IF (ONL) CALL TWRITE (ERRSTR)
                     CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                     GO TO 800
                  ELSE
                     STR = '*Warning* Image file missing for plate'
                     CALL STR_ADDI (STR, IPLATE, 1)
                     IF (ONL) CALL TWRITE (ERRSTR)
                     CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                     NOTDONE = NOTDONE + 1
                     GO TO 2000
                  END IF
               END IF
               IF (IFTYPE.EQ.1) THEN
                  CALL XDLF_OPEN_FILM_FILE (XDLSTR(IMGFIL),
     +                   LENSTR(IMGFIL),
     +                   IFD, IERR)
               ELSE IF (IFTYPE.EQ.2) THEN
                  CALL XDLF_OPEN_I2(XDLSTR(IMGFIL),LENSTR(IMGFIL),
     +                      IFD, IERR)
               END IF
               IF (IERR.NE.0) THEN
                  ERRSTR = '**Error** Error opening image file:'
                  CALL STR_ADDS (ERRSTR, IMGFIL, 1)
                  IF (ONL) CALL TWRITE (ERRSTR)
                  CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                  GO TO 800
               END IF
               IF (ONL) CALL TWRITE ('===Reading image===')
               IF (IFTYPE.EQ.1) THEN
                  ITYPE = 1
                  CALL XDLF_READ_FULL_FILM(IFD,KORD,NXRAST,NYRAST,
     +                              0,0,0,IMG,IERR)
                  CALL XDLF_CLOSE_FILM_FILE (IFD, IERR)
               ELSE IF (IFTYPE.EQ.2) THEN
                  ITYPE = 2
                  CALL XDLF_READ_FULL_I2(IFD,KORD,NXRAST,NYRAST,
     +                                   0,0,0,IMG,
     +                                   MINVAL,MAXVAL,IERR)
                  CALL XDLF_CLOSE_I2 (IFD, IERR)
               END IF
               IF (IERR.GT.0) THEN
                  ERRSTR = '**Error** Error reading image in record'
                  CALL STR_ADDI (ERRSTR, IERR, 1)
                  IF (ONL) CALL TWRITE (ERRSTR)
                  CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                  GO TO 800
               END IF
C
C====== Form profiles if key plate or profiles required for all plates
C
               IF (IPP.EQ.1.OR.PROF_ALL) THEN
                  IF (ONL) CALL TWRITE ('===Forming profiles===')
                  CALL LFN_SAINT (IPACK, IPLATE, 1, IMG, ITYPE, IORD,
     +                            NFRASTS, NXRAST, NYRAST, PROMIN, 
     +                            NTHE, PROF_ROT, NOVLD,
     +                            LFN_SOFT_PROG,
     +                            LFN_DUMMY_CNCL,
     +                            IERR, ERRSTR)
                  IF (IERR.NE.0) THEN
                     STR = '**Error** Integration routine error'
                     IF (ONL) THEN
                        CALL TWRITE (STR)
                        CALL TWRITE (ERRSTR)
                     END IF
                     CALL LOGSTR (IUN_LOG, STR, 1)
                     CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                     GO TO 800
                  END IF
                  CALL LOG_HEAD (IUN_LOG, 'Listing of Profiles', 2)
                  IF (IUN_LOG.GT.0) THEN
                     IF (OUT_SPAC) THEN
                        CALL OPN_SCR (IUN_TMP)
                        CALL LFN_LIST_PROFS (IUN_TMP, 0, 0, 0, 
     +                                80, 2, 2, IERR, ERRSTR)
                        CALL SCR_LOG (IUN_TMP, IUN_LOG)
                     ELSE
                        CALL LFN_LIST_PROFS (IUN_LOG, 0, 0, 0, 
     +                                80, 2, 2, IERR, ERRSTR)
                     END IF
                  END IF
               END IF
C
C====== Integrate plate 
C
               IF (ONL) CALL TWRITE ('===Integrating spots===')
               CALL LFN_SAINT (IPACK, IPLATE, 2, IMG, ITYPE, IORD,
     +                         NFRASTS, NXRAST, NYRAST, PROMIN, 
     +                         NTHE, PROF_ROT, NOVLD,
     +                         LFN_SOFT_PROG,
     +                         LFN_DUMMY_CNCL, 
     +                         IERR, ERRSTR)
               IF (IERR.NE.0) THEN
                  STR = '**Error** Integration routine error'
                  IF (ONL) THEN
                     CALL TWRITE (STR)
                     CALL TWRITE (ERRSTR)
                  END IF
                  CALL LOGSTR (IUN_LOG, STR, 1)
                  CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                  GO TO 800
               END IF
C
C====== Output diagnostic spots if required
C
               IF (IUN_DIAG.GT.0) CALL DIAG_OUTPUT (IUN_DIAG, IUN_LOG,
     +            IPACK, IPLATE, IMG, ITYPE, IORD, NFRASTS, NXRAST,
     +            NYRAST, PROMIN, NTHE, PROF_ROT, NOVLD)
C
C====== Copy spot data to internal LIRL
C
               IF (ONL) CALL TWRITE ('===Storing data internally===')
               DO 500 ISPOT = 1, NUMSPOTS
                  CALL LIRLF_NUMREFS (MINDX, NUMREFS)
                  CALL LRL_GET (ISPOT, IH, IK, IL, XD, YD, ALAM, DMTHR2,
     +                          MULT, OKNOD, SPOV, IERR)
                  IF (MULT.GT.1) THEN
                     CALL LRL_GET_HARM (ISPOT, IH, IK, IL, 
     +                                  IH_N, IK_N, IL_N,
     +                                  MULT, MINHARM, MAXHARM, INCHARM,
     +                                  ALNOD, DTHR2NOD, IERR)
                  ELSE
                     MINHARM = 0
                     MAXHARM = 0
                     INCHARM = 0
                  END IF
                  CALL LRL_GET_XFYFD (ISPOT, XFD, YFD, IERR)
                  CALL LRL_GET_OVLP (ISPOT, SPOV, CLOS, IERR)
                  CALL LRL_GET_INT (ISPOT, AI, SIGI, MEAS, BAD, OVLD,
     +                              ICODE, ICODE_TYPE, IERR)
                  ISPAT = 0
                  ICLOS = 0
                  IMEAS = 0
                  IBAD = 0
                  IOVLD = 0
                  IF (SPOV) ISPAT = 1
                  IF (CLOS) ICLOS = 1
                  IF (MEAS) IMEAS = 1
                  IF (BAD) IBAD = 1
                  IF (OVLD) IOVLD = 1
C
C====== Suppress any intensities from spatial overlaps if too close to
C====== deconvolute
C
                  IF (CLOS) THEN
                     IMEAS = 0
                     AI = 0.0
                     SIGI = 0.0
                  END IF

                  CALL LIRLF_ADDREF (MINDX, IH, IK, IL, IPACK,  
     +                         IPLATE, 0, XFD, YFD, ALAM, MULT, 
     +                         MINHARM, MAXHARM, 
     +                         INCHARM, AI, SIGI, ISPAT, ICLOS,
     +                         IMEAS, IBAD, IOVLD, ICODE, IERR)
                  IF (IERR.LT.0) THEN
                     ERRSTR = 
     +                   '**Error** Cannot allocate required memory'
                     IF (ONL) CALL TWRITE (ERRSTR)
                     CALL LOGSTR (IUN_LOG, ERRSTR, 1)
                     GO TO 800
                  END IF
                  CALL LRL_GET_OVPIX (ISPOT, NOV, IERR)
                  CALL LIRLF_SET_OVPIX (MINDX, NUMREFS+ISPOT, NOV, IERR) 
 500           CONTINUE
               IF (IOUT_TYPE.EQ.2.AND.IPLATE.EQ.1) 
     +                   CALL LAM_HIST (IPACK, LAMBDA_BINS)
C
C====== Collect and output summary statistics
C
               CALL LFN_INT_STATS1 (MINDX, IPACK, IPLATE, 
     +                              NS, NG, NO, NN, NB,  
     +                              AIM, AIS, N3, N10, IERR)
               CALL LOGSTR (IUN_LOG, ' ', 1)
               IF (IUN_LOG.GT.0) THEN
                  IF (OUT_SPAC) THEN
                     CALL OPN_SCR (IUN_TMP)
                     CALL LFN_INT_TAB1 (IUN_TMP, 0, KEY_LOG, 
     +                                  NS, NG, NO, NN, NB, 
     +                                  AIM, AIS, N3, N10)
                     CALL SCR_LOG (IUN_TMP, IUN_LOG)
                  ELSE
                     CALL LFN_INT_TAB1 (IUN_LOG, 0, KEY_LOG, 
     +                                  NS, NG, NO, NN, NB, 
     +                                  AIM, AIS, N3, N10)
                  END IF
               END IF
               KEY_LOG = 0
 2000       CONTINUE
 2100    CONTINUE
         IF (ONL) CALL TWRITE ('===Writing pack data to output file===')
         IF (IOUT_TYPE.EQ.1) THEN
            SORT_OK = .TRUE.
            CALL LIRLF_SORT (MINDX, 4, IERR)
            IF (IERR.NE.0) SORT_OK = .FALSE. 
            CALL LIRLF_SORT (MINDX, 1, IERR)
            IF (IERR.NE.0) SORT_OK = .FALSE. 
            IF (SORT_OK) THEN
               ISORT(1) = 1
               ISORT(2) = 2
               ISORT(3) = 3
               ISORT(4) = 6
               ISORT(5) = 0
            ELSE
               ISORT(1) = 0
               ISORT(2) = 0
               ISORT(3) = 0
               ISORT(4) = 0
               ISORT(5) = 0
            END IF
            CALL LDM_GET_A (CELL(1), IFLAG, ND)
            CALL LDM_GET_B (CELL(2), IFLAG, ND)
            CALL LDM_GET_C (CELL(3), IFLAG, ND)
            CALL LDM_GET_ALPHA (CELL(4),IFLAG, ND)
            CALL LDM_GET_BETA (CELL(5), IFLAG, ND)
            CALL LDM_GET_GAMMA (CELL(6), IFLAG, ND)
            CALL GET_FILNAM (TEMPLATE, IPACK_ID, 1, MTZ_FILE)
            CALL LWOPEN (1, MTZ_FILE)
            CALL LWTITL (1, TITL, 0)
            CALL LWCLAB (1, LABLS, 15, CTYPS, 0)
            CALL LWCELL (1, CELL)
            HSTRNG(1) = 'Integration by program INTLDM version'
            CALL STR_ADDS (HSTRNG(1), VERSTR, 1)
            CALL STR_ADDS (HSTRNG(1),'for pack id =', 1)
            CALL STR_ADDI (HSTRNG(1), IPACK_ID, 1)
            CALL LWHIST (1, HSTRNG, 1)
            CALL LDM_LWSYMM (1)
            CALL LWSORT (1,ISORT)
            CALL LIRLF_NUMREFS (MINDX, NUMSPOTS)
            IF (NUMSPOTS.GT.0) THEN
               DO 2200 ISPOT = 1, NUMSPOTS
                  CALL LIRLF_GETREF (MINDX, ISPOT, IH, IK, IL, 
     +               IPK, IPL, KSYM, XFD, YFD, ALAM, 
     +               MULT, MINHARM, MAXHARM, INCHARM,
     +               AI, SIGI, ISPAT, ICLOS, IMEAS, IBAD, IOVLD,
     +               ICODE, IERR)
                   CALL LIRLF_GET_OVPIX (MINDX, ISPOT, NOV, IERR)
                   ADATA(1) = IH
                   ADATA(2) = IK
                   ADATA(3) = IL
                   ADATA(4) = IPACK_ID
                   ADATA(5) = IPL
                   ADATA(6) = XFD
                   ADATA(7) = YFD
                   ADATA(8) = ALAM
                   ADATA(9) = SCAL*AI
                   ADATA(10) = SCAL*SIGI
                   ADATA(11) = MULT
                   ADATA(12) = MINHARM
                   ADATA(13) = MAXHARM
                   ADATA(14) = NOV
                   ADATA(15) = ISPAT + 2*ICLOS + 4*IOVLD + 8*IBAD
                   CALL LWREFL (1, ADATA)
 2200          CONTINUE
            END IF
            CALL LWCLOS (1, 0)
         ELSE
            CALL GET_FILNAM (TEMPLATE, IPACK_ID, 2, GE1_FILE)
            CALL GET_FILNAM (TEMPLATE, IPACK_ID, 3, GE2_FILE)
            IFAIL = 1
            CALL CCPDPN (-IUN_GE1, GE1_FILE,'UNKNOWN','DU',19,IFAIL)
            IF (IFAIL.LT.0) THEN
               ERRSTR = '**Error** Cannot open .ge1 file:'
               CALL STR_ADDS (ERRSTR, GE1_FILE, 1)
               IF (ONL) CALL TWRITE (ERRSTR)
               CALL LOGSTR (IUN_LOG, ERRSTR, 1)
               GO TO 800
            END IF
            IFAIL = 1
            CALL CCPDPN (-IUN_GE2, GE2_FILE,'UNKNOWN','DU',2,IFAIL)
            IF (IFAIL.LT.0) THEN
               ERRSTR = '**Error** Cannot open .ge2 file:'
               CALL STR_ADDS (ERRSTR, GE2_FILE, 1)
               IF (ONL) CALL TWRITE (ERRSTR)
               CALL LOGSTR (IUN_LOG, ERRSTR, 1)
               GO TO 800
            END IF
            CALL LFN_LIRLGE (MINDX, IUN_GE1, IUN_GE2, IPACK, SCAL,
     +                     LAMBDA_BINS, NUM_SPOTS, NUM_MULTIPLETS,
     +                     NUM_SPATIALS, NUM_BOTH, NUM_NODALS,
     +                     RESCALE, SCALOUT, IERR) 
            IF (RESCALE) THEN
               STR = '*Warning* Output scale factor reset to'
               CALL STR_ADDF (STR, SCALOUT, 4, 1)
               IF (ONL) CALL TWRITE (STR)
               CALL LOGSTR (IUN_LOG, STR, 1)
               RSC = .TRUE.
            END IF
            IF (IERR.EQ.1) THEN
               ERRSTR = '**Error** Could not allocate memory for sort'
               IF (ONL) CALL TWRITE (ERRSTR)
               CALL LOGSTR (IUN_LOG, ERRSTR, 1)
               GO TO 800
            END IF
         END IF
         CALL LIRLF_FREE (MINDX, IERR)
 2500 CONTINUE

      IF (NOTDONE.GT.0) THEN
         ERRSTR = 
     +      '**Error** Integration not done for all requested plates'
         IF (ONL) CALL TWRITE (ERRSTR)
         CALL LOGSTR (IUN_LOG, ERRSTR, 2)
      END IF
      IF (RSC) THEN
         ERRSTR = 
     +      '*Warning* Output scale factor reset for one or more packs'
         IF (ONL) CALL TWRITE (ERRSTR)
         CALL LOGSTR (IUN_LOG, ERRSTR, 2)
      END IF
      STOP
C
C====== Fatal error
C
 800  ERRSTR = '***Program Terminated***'
      IF (ONL) CALL TWRITE (ERRSTR)
      CALL LOGSTR (IUN_LOG, ERRSTR, 1)
      STOP
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C********************
C**     LOGSTR     **
C********************
C
C
      SUBROUTINE LOGSTR (IUN_LOG, STR, ILN)
C
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: Output message to log file
C
C AUTHOR:  John W. Campbell, November 1995
C
C ARGUMENTS:
C
      INTEGER IUN_LOG
      CHARACTER*(*) STR
      INTEGER ILN
C
C IUN_LOG    (R)  Unit no. for log file (0=none)
C STR        (R)  String to o/p
C ILN        (R)  No. of extra leading blank lines
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C
      INCLUDE 'ldm_prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER I

C     INTEGER I         !Temp/loop variable
C
C-------------------------------------------------------------------------------
C
      IF (IUN_LOG.LE.0) RETURN
      IF (ILN.GT.0) THEN
         DO 10 I = 1, ILN
            WRITE (IUN_LOG, 1000)
 10      CONTINUE
      END IF
      IF (OUT_SPAC) THEN
          WRITE (IUN_LOG, 1001) STR(1:LENSTR(STR))
      ELSE
          WRITE (IUN_LOG, 1002) STR(1:LENSTR(STR))
      END IF
      RETURN
C
C====== Format statements
C
 1000 FORMAT (' ')
 1001 FORMAT (' ',A)
 1002 FORMAT (A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GET_FILNAM       **
C**************************
C
C
      SUBROUTINE GET_FILNAM (TEMPLATE, PACK_ID, ITYP, FILNAM)
C
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: Form required output file name from template & pack id.
C
C AUTHOR:  John W. Campbell, November 1995
C
C ARGUMENTS:
C
      CHARACTER*(*) TEMPLATE
      INTEGER PACK_ID
      INTEGER ITYP
      CHARACTER*(*) FILNAM
C
C   TEMPLATE      (R)   File name template
C   PACK_ID       (R)   Pack id.
C   ITYP          (R)   File type 1=.mtz, 2=.ge1, 3=.ge2
C   FNAM          (W)   Returns the required file name
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C
      INCLUDE 'ldm_limits.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
C
C====== LOCALS:
C
      INTEGER NDIG
      INTEGER LL
      INTEGER I
      INTEGER J
      INTEGER ILEN
      CHARACTER*(MAXFLEN) FNAM
      CHARACTER*(MAXFLEN) FILTMP
      CHARACTER*(MAXFLEN) STR1
      CHARACTER*(MAXFLEN) STR2
      CHARACTER*80 STR
      CHARACTER*8 FRM

C     INTEGER NDIG                  !No. of digits in '#' field
C     INTEGER LL                    !String length
C     INTEGER I                     !Temp/loop variable
C     INTEGER J                     !Temp/loop variable
C     INTEGER ILEN                  !File name less extension length
C     CHARACTER*(MAXFLEN) FNAM      !File name string
C     CHARACTER*(MAXFLEN) FILTMP    !Temp file name string
C     CHARACTER*(MAXFLEN) STR1      !Temp string
C     CHARACTER*(MAXFLEN) STR2      !Temp string
C     CHARACTER*80 STR              !Temp string
C     CHARACTER*8 FRM               !Format string

      DATA FRM /'(I25.XX)'/
C
C-------------------------------------------------------------------------------
C
C
C====== Form file name from template 
C
      NDIG  = 1
      STR1 = ' '
      STR2 = ' '
      LL = LENSTR(TEMPLATE)
      I = 0
      J = 0
60    I = I + 1
      IF (TEMPLATE(I:I).NE.'#') THEN
         J = J + 1
         STR1(J:J) = TEMPLATE(I:I)
         GO TO 60
      END IF
70    I = I + 1
      IF (I.LE.LL) THEN
         IF (TEMPLATE(I:I).EQ.'#') THEN
            NDIG = NDIG + 1
            GO TO 70
         END IF
      END IF
      IF (I.LE.LL) STR2 = TEMPLATE(I:LL)
C
C====== Now add pack_id
C
      FNAM = STR1
      WRITE (FRM(6:7),'(I2.2)')NDIG
      WRITE (STR,FRM) PACK_ID
      LL = LENSTR(STR)
      J = 0
      DO 80 I = 1, LL
         IF (STR(I:I).NE.' ') THEN
            STR = STR(I:LL)
            GO TO 90
         END IF
80    CONTINUE
90    CALL STR_ADDS(FNAM,STR,0)
      CALL STR_ADDS (FNAM,STR2,0)
      CALL FILEXT (FNAM, 'xxx', FILTMP, ILEN)
      FNAM = FILTMP(1:ILEN)
      IF (ITYP.EQ.1) THEN
         CALL FILEXT (FNAM, 'mtz', FILNAM, ILEN)
      ELSE IF (ITYP.EQ.2) THEN
         CALL FILEXT (FNAM, 'ge1', FILNAM, ILEN)
      ELSE IF (ITYP.EQ.3) THEN
         CALL FILEXT (FNAM, 'ge2', FILNAM, ILEN)
      END IF
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LAM_HIST         **
C**************************
C
C
      SUBROUTINE LAM_HIST (IPACK, LAMBDA_BINS)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get wavelength histogram (16 bins)
C
C Author:  John W. Campbell, Novemnber 1995
C
C Arguments:
C
      INTEGER IPACK
      INTEGER LAMBDA_BINS(16)
C
C IPACK           (R) Pack number
C LAMBDA_BINS(16) (W) Returned histogram
C
C====== Parameter statements
C 
      INCLUDE 'ldm_limits.finc'
C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      
C
C====== LOCALS:
C
      LOGICAL SPAT
      LOGICAL NODFLG
      INTEGER I
      INTEGER J
      INTEGER IFLAG
      INTEGER ND
      INTEGER IERR
      INTEGER NUMSPOTS
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER MULT
      REAL DTHR2
      REAL XFD
      REAL YFD
      REAL BIN_CUTOFF(16)
      REAL LAMBDA
      REAL WMIN
      REAL WMAX
      CHARACTER*2 ERRSTR

C     LOGICAL SPAT          !Spatial overlap flag
C     LOGICAL NODFLG        !OK nodal flag
C     INTEGER I             !Loop variable
C     INTEGER J             !Loop variable
C     INTEGER IFLAG         !Parameter status flag
C     INTEGER ND            !No. of decimal places flag
C     INTEGER IERR          !Error flag
C     INTEGER NUMSPOTS      !No. of spots in list
C     INTEGER JH            !'h' index
C     INTEGER JK            !'k' index
C     INTEGER JL            !'l' index
C     INTEGER MULT          !Multiplicity
C     REAL DTHR2            !dmin-thresh**2
C     REAL XFD              !Spot 'x' position
C     REAL YFD              !Spot 'y' position
C     REAL BIN_CUTOFF(16)   !Upper Lambda limits for each bin
C     REAL LAMBDA           !Wavelength of current reflection
C     REAL WMIN             !Lambda-min
C     REAL WMAX             !Lambda-max
C     CHARACTER*2 ERRSTR    !Error string (dummy)
C
C-------------------------------------------------------------------------------
C
C
C====== Set up bins
C
      CALL LDM_GET_LMIN (IPACK, WMIN, IFLAG, ND, IERR, ERRSTR)
      CALL LDM_GET_LMAX (IPACK, WMAX, IFLAG, ND, IERR, ERRSTR)
      DO 20 I = 1 , 16
         BIN_CUTOFF(I) = WMIN + I*(WMAX-WMIN)/15.0
         LAMBDA_BINS(I) = 0
 20   CONTINUE
      BIN_CUTOFF(16) = 100.0
C
C====== Work out histogram
C
      CALL LRL_NUMSPOTS (NUMSPOTS)
      DO 50 J = 1 , NUMSPOTS
         CALL LRL_GET (J, JH, JK, JL, XFD, YFD, LAMBDA, DTHR2, MULT,
     +                       NODFLG, SPAT, IERR)
         DO 30 I = 1 , 16
            IF (LAMBDA.LT.BIN_CUTOFF(I)) GO TO 40
 30      CONTINUE
         I = 16
 40      LAMBDA_BINS(I) = LAMBDA_BINS(I) + 1
 50   CONTINUE
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*********************
C**    READ_LDM     **
C*********************
C
C
      SUBROUTINE READ_LDM (IUN_LDM, ONL, IUN_LOG) 
C
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: Read in LDM data
C
C AUTHOR:  John W. Campbell, November 1995
C
C ARGUMENTS:
C
      INTEGER IUN_LDM
      LOGICAL ONL
      INTEGER IUN_LOG
C
C  IUN_LDM    (R)  Unit no. for LDM read (assumed that file already open
C  ONL        (R)  On-line flag
C  IUN_LOG    (R)  Unit no. of log file
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      LOGICAL ERR
      LOGICAL NONLDM
      LOGICAL EOF
      INTEGER INDIRECT
      INTEGER IERR
      INTEGER KFLAG
      CHARACTER*250 LIN
      CHARACTER*120 ERRSTR
      CHARACTER*120 STR
      CHARACTER*80 BADTOK

C     LOGICAL ERR           !Error flag
C     LOGICAL NONLDM        !Non-LDM data present flag
C     LOGICAL EOF           !End-of-file flag
C     INTEGER INDIRECT      !Indirection level
C     INTEGER IERR          !Error flag
C     INTEGER KFLAG         !LDM parse flag
C     CHARACTER*250 LIN     !Line read fro LDM file
C     CHARACTER*120 ERRSTR  !Error string
C     CHARACTER*120 STR     !Temp/message string
C     CHARACTER*80 BADTOK   !Bad token

C
C-------------------------------------------------------------------------------
C
      IF (ONL) CALL TWRITE ('===Reading LDM file===')
      ERR = .FALSE.
      NONLDM = .FALSE.
      INDIRECT = 0
30    CALL LDM_READLINE (IUN_LDM, 10, INDIRECT, LIN, EOF, IERR)
      IF (EOF) GO TO 40
      IF (IERR.GT.0) THEN
         ERRSTR = '**Error** LDM_READLINE error, ierr='
         CALL STR_ADDI (ERRSTR,IERR,0)
         IF (ONL) CALL TWRITE (ERRSTR)
         CALL LOGSTR (IUN_LOG, ERRSTR, 1)
         ERR = .TRUE.
         GO TO 40
      END IF
      CALL LDM_PARSE (LIN, KFLAG, BADTOK, ERRSTR)
      IF (KFLAG.LT.0) THEN
         IF (ONL) CALL TWRITE ('**Error** LDM_PARSE error')
         CALL LOGSTR (IUN_LOG, '**Error** LDM_PARSE error', 1)
         STR = 'Line:'
         CALL STR_ADDS (STR, LIN, 1)
         IF (ONL) CALL TWRITE (STR)
         CALL LOGSTR (IUN_LOG, STR, 0)
         STR = 'Bad token:'
         CALL STR_ADDS (STR, BADTOK, 1)
         IF (ONL) CALL TWRITE (STR)
         CALL LOGSTR (IUN_LOG, STR, 0)
         STR = 'Error message:'
         CALL STR_ADDS (STR, ERRSTR, 1)
         IF (ONL) CALL TWRITE (STR)
         CALL LOGSTR (IUN_LOG, STR, 0)
         ERR = .TRUE.
         GO TO 30
      END IF
      IF (KFLAG.EQ.1) NONLDM = .TRUE.
      GO TO 30
C
C====== End of file (or fatal error)
C
40    IF (ERR) THEN
         IF (ONL) CALL TWRITE ('***Program Terminated***')
         CALL LOGSTR (IUN_LOG, '***Program Terminated***', 1)
         STOP
      END IF
      IF (NONLDM) THEN
         STR = '*Warning* Non-LDM data present'
         IF (ONL) CALL TWRITE (STR)
         CALL LOGSTR (IUN_LOG, STR, 1)
      END IF
      IF (ONL) CALL TWRITE('===Reading completed===')
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     READ_ONL_CTL     **
C**************************
C
C
      SUBROUTINE READ_ONL_CTL (IUN_LDM, IUN_LOG, PAR_FILE, IOUT_TYPE, 
     +                         TEMPLATE, PROMIN, NTHE, PROF_ROT,
     +                         PROF_ALL, NOVLD, SCAL, KPACK)
C
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: Read control data in on-line mode (also read & log LDM data)
C
C AUTHOR:  John W. Campbell, November 1995
C
C ARGUMENTS:
C
      INTEGER IUN_LDM
      INTEGER IUN_LOG
      CHARACTER*(*) PAR_FILE
      INTEGER IOUT_TYPE
      CHARACTER*(*) TEMPLATE
      REAL PROMIN
      INTEGER NTHE
      LOGICAL PROF_ROT
      LOGICAL PROF_ALL
      INTEGER NOVLD
      REAL SCAL
      INTEGER KPACK
C
C IUN_LDM    (R)   Unit no. for reading LDM file.
C IUN_LOG    (W)   Unit no. for log file (0 if none).
C IOUT_TYPE  (W)   Output file type 1=mtz, 2=.ge1/.ge2.
C TEMPLATE   (W)   File name template for integrated intensities files.
C PROMIN     (W)   Minimum intensity to include in profile determination.
C NTHE       (W)   No. of theta bins for profiles.
C PROF_ROT   (W)   Rotate profiles flag
C PROF_ALL   (W)   Calculate profiles for all plates in pack. 
C                  .true. yes, .false. no (only relevant if >1 plates/pack)
C NOVLD      (W)   No. of overload pixels allowed in an OK spot
C SCAL       (W)   Scale for output intensities.
C KPACK      (R/W) Pack no. for integration 0=all.
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C
      INCLUDE 'ldm_limits.finc'
      INCLUDE 'ldm_prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER NXTTOK
      INTEGER LDM_INTFP
C
C====== LOCALS:
C
      LOGICAL QUIT
      LOGICAL EXISTS
      LOGICAL SAVL
      INTEGER I
      INTEGER IFAIL
      INTEGER IERR
      INTEGER JL
      INTEGER M1
      INTEGER M2
      INTEGER IRET
      INTEGER IMTYP
      INTEGER NUMPACKS
      INTEGER NPLATES
      INTEGER IFLAG
      INTEGER ITYP
      INTEGER IVAL
      INTEGER ND
      INTEGER ISAV
      REAL FP
      REAL FSAV
      CHARACTER*2 VALSTR
      CHARACTER*(MAXFLEN) FILNAM
      CHARACTER*(MAXFLEN) STRSAV  
      CHARACTER*120 ERRSTR
      CHARACTER*120 STR
      CHARACTER*100 PRMPSTR

C     LOGICAL QUIT                  !Quit program flag
C     LOGICAL EXISTS                !File exists flag
C     LOGICAL SAVL                  !Save a logical value
C     INTEGER I                     !Temp/loop variable
C     INTEGER IFAIL                 !File open failure flag
C     INTEGER IERR                  !Error flag
C     INTEGER JL                    !Current position in string
C     INTEGER M1                    !Start position of token in string
C     INTEGER M2                    !End position of token in string
C     INTEGER IRET                  !return code
C     INTEGER IMTYP                 !Image type flag
C     INTEGER NUMPACKS              !No. of packs
C     INTEGER NPLATES               !No. of plates
C     INTEGER IFLAG                 !LDM parameter status flag
C     INTEGER ITYP                  !Parameter type flag
C     INTEGER IVAL                  !Parameter integer value
C     INTEGER ND                    !Parameter no. of decimal places flag
C     INTEGER ISAV                  !Save an integer value
C     REAL FP                       !Parameter real value
C     REAL FSAV                     !Save real value
C     CHARACTER*2 VALSTR            !Parameter value string (dummy)
C     CHARACTER*(MAXFLEN) FILNAM    !File name string
C     CHARACTER*(MAXFLEN) STRSAV    !Save (template) string
C     CHARACTER*120 ERRSTR          !Error string
C     CHARACTER*120 STR             !Temp/message string
C     CHARACTER*100 PRMPSTR         !Prompt string
C
C-------------------------------------------------------------------------------
C
      PROF_ALL = .FALSE.
C
C====== Read in LDM file name
C
20    CALL TPROMP ('LDM parameters file name (default ext=.ldm): ') 
      CALL TREAD (FILNAM, QUIT)
      IF (QUIT) STOP
      IF (FILNAM.EQ.' ') GO TO 20
      CALL FILEXT (FILNAM, 'ldm', PAR_FILE, I)
      EXISTS = CCPEXS (PAR_FILE)
      IF (.NOT.EXISTS) THEN
         ERRSTR = '**Error** File not found'
         CALL TWRITE (ERRSTR)
         GO TO 20
      END IF
      IFAIL = 1
      CALL CCPDPN (-IUN_LDM, PAR_FILE, 'READONLY', 'F', 0, IFAIL)
      IF (IFAIL.LT.0) THEN
         ERRSTR = '**Error in opening LDM file**'
         CALL TWRITE (ERRSTR)
         GO TO 20
      END IF
C
C====== Read in LDM parameters
C
      CALL READ_LDM (IUN_LDM, .TRUE., IUN_LOG)
      CLOSE (IUN_LDM)
C
C====== Write name of LDM parameters file
C
      STR = 'Name of LDM parameters file:'
      CALL STR_ADDS (STR, PAR_FILE, 1)
      CALL LOGSTR (IUN_LOG, STR, 1)
C
C====== Write out current LDM parameters
C
      CALL LOGSTR (IUN_LOG, 'Current LDM parameter values:-', 1)
      CALL LOGSTR (IUN_LOG, ' ', 0)
      IF (IUN_LOG.GT.0) THEN
         IF (OUT_SPAC) THEN
            CALL OPN_SCR (IUN_TMP)
            CALL LDM_WRITE (IUN_TMP, 2)
            CALL SCR_LOG (IUN_TMP, IUN_LOG)
         ELSE
            CALL LDM_WRITE (IUN_LOG, 2)
         END IF
      END IF
C
C====== Get current values for integration specific parameters
C====== from extended LDM data
C
      CALL LDM_GET ('INT_TEMPLATE', 1, 1, TEMPLATE, 
     +               FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      
      CALL LDM_GET ('INT_FTYPE', 1, 1, STR, FP, ND, IVAL,
     +              IFLAG, ITYP, IERR, ERRSTR)
      IOUT_TYPE = 1
      IF (STR.EQ.'ge') IOUT_TYPE = 2
      
      CALL LDM_GET ('PROMIN', 1, 1, STR, 
     +              PROMIN, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (PROMIN.EQ.0.0) THEN
         CALL LFN_SAINT_DF (IVAL, PROMIN, PROF_ROT)
         WRITE (STR,'(F8.1)') PROMIN
         CALL LJUST(STR)
         CALL LDM_SET ('PROMIN', 1, 1, STR, IERR, ERRSTR) 
      END IF

      CALL LDM_GET ('NPROF', 1, 1, STR, 
     +              FP, ND, NTHE, IFLAG, ITYP, IERR, ERRSTR)
      
      CALL LDM_GET ('PROF_ROTATE', 1, 1, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      PROF_ROT = .FALSE.
      IF (STR.EQ.'yes') PROF_ROT = .TRUE.

      CALL LDM_GET ('PROF_ALL', 1, 1, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      PROF_ALL = .FALSE.
      IF (STR.EQ.'yes') PROF_ALL = .TRUE.
      
      CALL LDM_GET ('OVLIM', 1, 1, STR, 
     +              FP, ND, NOVLD, IFLAG, ITYP, IERR, ERRSTR)

      CALL LDM_GET ('SCALE_INT', 1, 1, STR, 
     +              SCAL, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (SCAL.EQ.0.0) THEN
         CALL LDM_GET_IMTYP (STR, IMTYP, IFLAG)
         IF (IMTYP.EQ.1) THEN
            SCAL = 1.0            
         ELSE
            SCAL = 0.1
         END IF
         WRITE (STR,'(F8.1)') SCAL
         CALL LJUST(STR)
         CALL LDM_SET ('SCALE_INT', 1, 1, STR, IERR, ERRSTR) 
      END IF
C
C====== Read in output file type IOUT_TYPE
C
      ISAV = IOUT_TYPE
30    IF (IOUT_TYPE.EQ.1) THEN
         CALL TPROMP ('Output file type (mtz/ge) [mtz]: ') 
      ELSE
         CALL TPROMP ('Output file type (mtz/ge) [ge]: ') 
      END IF
      CALL TREAD (STR, QUIT)
      IF (QUIT) STOP
      JL = 0
      IRET = NXTTOK (STR, ' ,', JL, M1, M2)
      IF (IRET.GT.0) THEN
         CALL CCPUPC (STR)
         IF (STR(M1:M1).NE.'G'.AND.STR(M1:M1).NE.'M') THEN
            ERRSTR = '**Error** Invalid output file type:'
            CALL STR_ADDS (ERRSTR, STR(M1:M2), 1)
            CALL TWRITE (ERRSTR)
            GO TO 30
         END IF
         IF (STR(1:1).EQ.'G') THEN
            STR = 'ge'
            IOUT_TYPE = 2
         ELSE
            STR = 'mtz'
            IOUT_TYPE = 1
         END IF
         IF (IOUT_TYPE.NE.ISAV) CALL LDM_SET ('INT_FTYPE', 1, 1, 
     +                          STR, IERR, ERRSTR)
      END IF
C
C====== Read in output file name template TEMPLATE
C
      STRSAV = TEMPLATE
40    PRMPSTR = 'Template for intensity file names ['
      CALL STR_ADDS(PRMPSTR, TEMPLATE, 0)
      CALL STR_ADDS(PRMPSTR,']:',0)
      CALL TPROMP (PRMPSTR) 
      CALL TREAD (STR, QUIT)
      IF (QUIT) STOP
      IF (STR.EQ.' ') STR = TEMPLATE
      CALL LJUST (STR)
      IF (INDEX(STR,'#').EQ.0) THEN
         ERRSTR = '**Error** Template (with # field) must be given'
         CALL TWRITE (ERRSTR)
         GO TO 40
      END IF
      IF (STR.NE.STRSAV) CALL LDM_SET ('INT_TEMPLATE', 1, 1, 
     +                   STR, IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         CALL TWRITE (ERRSTR)
         GO TO 40
      END IF
      TEMPLATE = STR
C
C====== Read minimum intensity for inclusion in profiles PROMIN
C
      FSAV = PROMIN
 50   FP = PROMIN
      CALL TASKF ('Minimum intensity for profiles', FP, 1, QUIT)
      IF (QUIT) STOP
      WRITE (STR,'(F20.4)') FP
      CALL LJUST (STR)
      IF (FP.NE.FSAV) CALL LDM_SET ('PROMIN', 1, 1, STR, IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         CALL TWRITE (ERRSTR)
         GO TO 50
      END IF
      PROMIN = FP
C
C====== Read no. of profiles bins NTHE
C
      ISAV = NTHE
60    IVAL = NTHE
      CALL TASKI ('Number of bins for collecting profiles', IVAL, QUIT)
      IF (QUIT) STOP
      WRITE (STR,'(I10)') IVAL
      CALL LJUST (STR)
      IF (IVAL.NE.ISAV) CALL LDM_SET ('NPROF', 1, 1, STR, IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         CALL TWRITE (ERRSTR)
         GO TO 60
      END IF
      NTHE = IVAL
C
C====== Read rotate profiles flag PROF_ROTATE 
C
      SAVL = PROF_ROT
      CALL TASKQ ('Rotate profiles for elliptical spots', PROF_ROT, 
     +             QUIT)
      IF (PROF_ROT.NEQV.SAVL) THEN
         IF (PROF_ROT) THEN
            CALL LDM_SET ('PROF_ROTATE', 1, 1, 'yes', IERR, ERRSTR)
         ELSE
            CALL LDM_SET ('PROF_ROTATE', 1, 1, 'no', IERR, ERRSTR)
         END IF
      END IF
      IF (QUIT) STOP
C
C====== Read PROF_ALL (if more than 1 plate/pack)
C
      SAVL = PROF_ALL
      CALL LDM_GET_NPLAT (NPLATES, IFLAG)
      IF (NPLATES.GT.1) THEN
         CALL TASKQ ('Form profiles for each plate in pack', PROF_ALL, 
     +                QUIT)
         IF (PROF_ALL.NEQV.SAVL) THEN
            IF (PROF_ALL) THEN
                CALL LDM_SET ('PROF_ALL', 1, 1, 'yes', IERR, ERRSTR)
            ELSE
                CALL LDM_SET ('PROF_ALL', 1, 1, 'no', IERR, ERRSTR)
            END IF
         END IF
         IF (QUIT) STOP
      END IF
C
C====== Read no. of overload pixels allowed in an OK spot
C
      ISAV = NOVLD
70    IVAL = NOVLD
      CALL TASKI ('Number of overload pixels allowed in a spot', 
     +            IVAL, QUIT)
      IF (QUIT) STOP
      WRITE (STR,'(I10)') IVAL
      CALL LJUST (STR)
      IF (IVAL.NE.ISAV) CALL LDM_SET ('OVLIM', 1, 1, STR, IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         CALL TWRITE (ERRSTR)
         GO TO 70
      END IF
      NOVLD = IVAL
C
C====== Read scale factor for output intensities SCAL
C
      FSAV = SCAL
80    FP = SCAL
      CALL TASKF ('Scale for output intensities', FP, 1, QUIT)
      IF (QUIT) STOP
      WRITE (STR,'(F20.6)') FP
      CALL LJUST (STR)
      IF (FP.NE.FSAV) CALL LDM_SET ('SCALE_INT', 1, 1, 
     +                               STR, IERR, ERRSTR)
      IF (IERR.NE.0) THEN
         CALL TWRITE (ERRSTR)
         GO TO 80
      END IF
      SCAL = FP
C
C====== Read no. of pack to integrate (0=all packs) KPACK
C
90    IVAL = KPACK
      CALL TASKI ('Number of pack to integrate (0=all)', IVAL, QUIT)
      IF (QUIT) STOP
      CALL LDM_GET_NUMP (NUMPACKS, IFLAG)
      IF (IVAL.LT.0.OR.IVAL.GT.NUMPACKS) THEN
         ERRSTR = '**Error** Invalid pack number:'
         CALL STR_ADDI (ERRSTR, IVAL, 1)
         CALL TWRITE (ERRSTR) 
         GO TO 90
      END IF
      KPACK = IVAL
C
C====== Write out changed  LDM parameters
C
      CALL LOGSTR (IUN_LOG, 'Changed LDM parameter values:-', 1)
      CALL LOGSTR (IUN_LOG, ' ', 0)
      IF (IUN_LOG.GT.0) THEN
         IF (OUT_SPAC) THEN
            CALL OPN_SCR (IUN_TMP)
            CALL LDM_WRITE (IUN_TMP, -1)
            CALL SCR_LOG (IUN_TMP, IUN_LOG)
         ELSE
            CALL LDM_WRITE (IUN_LOG, -1)
         END IF
      END IF    
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     READ_LDM_CTL     **
C**************************
C
C
      SUBROUTINE READ_LDM_CTL (IUN_IN, IUN_LOG, KPACK, IOUT_TYPE, 
     +                         TEMPLATE, PROMIN, NTHE, PROF_ROT,
     +                         PROF_ALL, NOVLD, SCAL)
C
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: Read control data in off-line mode
C
C AUTHOR:  John W. Campbell, November 1995
C
C ARGUMENTS:
C
      INTEGER IUN_IN
      INTEGER IUN_LOG
      INTEGER KPACK
      INTEGER IOUT_TYPE
      CHARACTER*(*) TEMPLATE
      REAL PROMIN
      INTEGER NTHE
      LOGICAL PROF_ROT
      LOGICAL PROF_ALL
      INTEGER NOVLD
      REAL SCAL
C
C IUN_IN     (R)  Unit no. from which to read keyword data
C IUN_LOG    (R)  Unit no. for log file (0 if none).
C KPACK      (R)  Pack no. for integration 0=all. (to be checked) 
C IOUT_TYPE  (W)  Output file type 1=mtz, 2=.ge1/.ge2.
C TEMPLATE   (W)  File name template for integrated intensities files.
C PROMIN     (W)  Minimum intensity to include in profile determination.
C NTHE       (W)  No. of theta bins for profiles.
C PROF_ROT   (W)  Rotate profiles flag 
C PROF_ALL   (W)  Calculate profiles for all plates in pack. 
C                 .true. yes, .false. no (only relevant if >1 plates/pack)
C NOVLD      (W)  No. of overload pixels allowed in an OK spot
C SCAL       (W)  Scale for output intensities.
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C
      INCLUDE 'ldm_limits.finc'
      INCLUDE 'ldm_prog_flags.finc'
C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER KDMSTR
C
C====== LOCALS:
C
      LOGICAL NONLDM
      LOGICAL EOF
      INTEGER INDIRECT
      INTEGER IERR
      INTEGER IFLAG
      INTEGER KFLAG
      INTEGER IFAIL
      INTEGER IMTYP
      INTEGER NUMPACKS
      INTEGER ITYP
      INTEGER IVAL
      INTEGER ND
      REAL FP
      CHARACTER*250 LIN
      CHARACTER*120 ERRSTR
      CHARACTER*120 BADTOK
      CHARACTER*120 STR

C     LOGICAL NONLDM                !Non-LDM data present flag   
C     LOGICAL EOF                   !End-of-file flag
C     INTEGER INDIRECT              !Indirection level
C     INTEGER IERR                  !Error flag
C     INTEGER IFLAG                 !LDM parameter status flag
C     INTEGER KFLAG                 !LDM parse flag
C     INTEGER IFAIL                 !File open failure flag
C     INTEGER IMTYP                 !Image type flag
C     INTEGER NUMPACKS              !No. of packs
C     INTEGER ITYP                  !Parameter type flag
C     INTEGER IVAL                  !Parameter integer value
C     INTEGER ND                    !Parameter no. of decimal places flag
C     REAL FP                       !Parameter real value
C     CHARACTER*250 LIN             !Line read from LDM file
C     CHARACTER*120 ERRSTR          !Error string    
C     CHARACTER*120 BADTOK          !Bad token 
C     CHARACTER*120 STR             !Temp/message string
C
C-------------------------------------------------------------------------------
C
C
C====== Read Extended LDM data
C
      NONLDM = .FALSE.
      INDIRECT = 0
10    CALL LDM_READLINE (IUN_IN, 12, INDIRECT, LIN, EOF, IERR)
      IF (EOF) GO TO 20
      IF (IERR.GT.0) THEN
         STR = '**Error** LDM_READLINE error, ierr='
         CALL STR_ADDI (STR,IERR,0)
         CALL LOGSTR (IUN_LOG, STR, 1)
         CALL LOGSTR (IUN_LOG, '***Program Terminated***', 1)
         STOP
      END IF
      CALL LDM_PARSE (LIN, KFLAG, BADTOK, ERRSTR)
      IF (KFLAG.EQ.0.OR.KFLAG.EQ.2) GO TO 10
      IF (KFLAG.EQ.1) NONLDM = .TRUE.
      GO TO 10
C
C====== End of file (or fatal error)
C
20    IF (NONLDM) THEN
         CALL LOGSTR (IUN_LOG, '*Warning* Non-LDM data present', 1)
      END IF
C
C====== Get extended LDM parameters for integration & make further 
C====== checks if required
C
      CALL LDM_GET ('INT_TEMPLATE', 1, 1, TEMPLATE, 
     +               FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (IERR.NE.0) GO TO 800 
      IF (INDEX(TEMPLATE,'#').EQ.0) THEN
         ERRSTR = '**Error** Template (with # field) must be given'
         CALL LOGSTR (IUN_LOG, ERRSTR, 1) 
         GO TO 800
      END IF
      
      CALL LDM_GET ('INT_FTYPE', 1, 1, STR, FP, ND, IVAL,
     +              IFLAG, ITYP, IERR, ERRSTR)
      IOUT_TYPE = 1
      IF (STR.EQ.'ge') IOUT_TYPE = 2
      
      CALL LDM_GET ('PROMIN', 1, 1, STR, 
     +              PROMIN, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (PROMIN.EQ.0.0) THEN
         CALL LFN_SAINT_DF (IVAL, PROMIN, PROF_ROT)
         WRITE (STR,'(F8.1)') PROMIN
         CALL LJUST(STR)
         CALL LDM_SET ('PROMIN', 1, 1, STR, IERR, ERRSTR) 
      END IF

      CALL LDM_GET ('NPROF', 1, 1, STR, 
     +              FP, ND, NTHE, IFLAG, ITYP, IERR, ERRSTR)
      
      CALL LDM_GET ('PROF_ROTATE', 1, 1, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      PROF_ROT = .FALSE.
      IF (STR.EQ.'yes') PROF_ROT = .TRUE.

      CALL LDM_GET ('PROF_ALL', 1, 1, STR, 
     +              FP, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      PROF_ALL = .FALSE.
      IF (STR.EQ.'yes') PROF_ALL = .TRUE.
      
      CALL LDM_GET ('SCALE_INT', 1, 1, STR, 
     +              SCAL, ND, IVAL, IFLAG, ITYP, IERR, ERRSTR)
      IF (SCAL.EQ.0.0) THEN
         CALL LDM_GET_IMTYP (STR, IMTYP, IFLAG)
         IF (IMTYP.EQ.1) THEN
            SCAL = 1.0            
         ELSE
            SCAL = 0.1
         END IF
      END IF

      CALL LDM_GET_NUMP (NUMPACKS, IFLAG)
      IF (KPACK.LT.0.OR.KPACK.GT.NUMPACKS) THEN
         ERRSTR = '**Error** Invalid pack number:'
         CALL STR_ADDI (ERRSTR, KPACK, 1)
         CALL LOGSTR (IUN_LOG, ERRSTR, 1)
         GO TO 800
      END IF
C
C====== Write out current LDM parameters
C
      CALL LOGSTR (IUN_LOG, 'Current LDM parameter values:-', 1)
      CALL LOGSTR (IUN_LOG, ' ', 0)
      IF (IUN_LOG.GT.0) THEN
         IF (OUT_SPAC) THEN
            CALL OPN_SCR (IUN_TMP)
            CALL LDM_WRITE (IUN_TMP, 2)
            CALL SCR_LOG (IUN_TMP, IUN_LOG)
         ELSE
            CALL LDM_WRITE (IUN_LOG, 2)
         END IF
      END IF
      RETURN
C
C====== Fatal error
C
 800  CALL LOGSTR (IUN_LOG, '***Program Terminated***', 1)
      STOP
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LOG_HEAD         **
C**************************
C
      SUBROUTINE LOG_HEAD (IUN_LOG, CHSTR, ITYP)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose:    Output heading to log file for INTLDM
C
C Author:     John W. Campbell, November 1995
C
C Arguments:
C
      INTEGER IUN_LOG
      CHARACTER*(*) CHSTR
      INTEGER ITYP
C
C    IUN_LOG  (R)   Unit no. for log file (0 if none)
C    CHSTR    (R)   The message string
C    ITYP     (R)   Heading type flag =1, standard (preceeded by 1 blank line)
C                                     =2, as for 1 but underlined with '---'
C                                     =3, as for 1 but underlined with '==='
C
C Declarations
C ============
C
C GLOBALS:
C
      INCLUDE 'ldm_prog_flags.finc'
C
C LOCALS:
C
      INTEGER LENS
      INTEGER I
      INTEGER NCH

C     INTEGER LENS   !Length of the character string
C     INTEGER I      !Loop counter
C     INTEGER NCH    !No. characters up to last non-blank character
C
C-------------------------------------------------------------------------------
C
      IF (IUN_LOG.EQ.0) RETURN
C
C====== Find length of message string up to last non-blank
C
      LENS = LEN (CHSTR)
      NCH = 1
      DO 100 I = LENS, 1, -1
      IF (CHSTR(I:I).NE.' ') THEN
         NCH = I
         GO TO 200
      ENDIF
100   CONTINUE
C
C====== Output the heading
C
200   IF (ITYP.LE.3) THEN
         WRITE(IUN_LOG,1000)
         IF (OUT_SPAC) THEN
            WRITE (IUN_LOG,1001) CHSTR(1:NCH)
         ELSE
            WRITE (IUN_LOG,1002) CHSTR(1:NCH)
         END IF
      END IF
      IF (ITYP.EQ.2) THEN
         IF (OUT_SPAC) THEN
            WRITE(IUN_LOG,1005) ('-',I=1,NCH)
         ELSE
            WRITE(IUN_LOG,1006) ('-',I=1,NCH)
         END IF
      ELSE IF (ITYP.EQ.3) THEN
         IF (OUT_SPAC) THEN
            WRITE(IUN_LOG,1005) ('=',I=1,NCH)
         ELSE
            WRITE(IUN_LOG,1006) ('=',I=1,NCH)
         END IF
      END IF
      RETURN
C
C====== Format statements
C
1000  FORMAT (' ')
1001  FORMAT (' ',A)
1002  FORMAT (A)
1005  FORMAT (' ',120A1)
1006  FORMAT (120A1)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     DIAG_OUTPUT      **
C**************************
C
C
      SUBROUTINE DIAG_OUTPUT (IUN_DIAG, IUN_LOG, IPACK, IPLATE, IMG, 
     +                        ITYPE, IORD, NFRASTS, NXRAST, NYRAST, 
     +                        PROMIN, NTHE, PROF_ROT, NOVLD)
C
      INCLUDE 'implicit_none.finc'
C
C PURPOSE: 
C
C AUTHOR:  John W. Campbell, November 1995
C
C ARGUMENTS:
C
      INTEGER IUN_DIAG
      INTEGER IUN_LOG
      INTEGER IPACK
      INTEGER IPLATE
      INTEGER IMG(*)
      INTEGER ITYPE
      INTEGER IORD
      INTEGER NFRASTS
      INTEGER NXRAST
      INTEGER NYRAST
      REAL PROMIN
      INTEGER NTHE
      LOGICAL PROF_ROT
      INTEGER NOVLD
C
C IUN_DIAG  (R)  Unit number for diagnostics file (already open)
C IUN_LOG   (R)  Unit no. for log file (0 if none)
C IPACK     (R)  Pack no.
C IPLATE    (R)  Plate no.
C IMG       (R)  In memory image
C ITYPE     (R)  Data type in image flag
C IORD      (R)  Data order in image flag
C NFRASTS   (R)  No. of fast moving rasters between slow rasters in image
C NXRAST    (R)  No. of 'x' rasters
C NYRAST    (R)  No. of 'y' rasters
C PROMIN    (R)  Minimum intensity for inclusion in profiles
C NTHE      (R)  No. of profile collection bins
C PROF_ROT  (R)  Rotate profiles flag
C NOVLD     (R)  No. of overload pixels to allow in an OK spot intensity
C    
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      EXTERNAL LFN_SOFT_PROG
      LOGICAL LFN_DUMMY_CNCL
      EXTERNAL LFN_DUMMY_CNCL
C
C====== LOCALS:
C
      LOGICAL FIRST
      LOGICAL OKNOD
      LOGICAL SPOV
      INTEGER IPK
      INTEGER IPL
      INTEGER JH
      INTEGER JK
      INTEGER JL
      INTEGER ISPOT
      INTEGER KSPOT
      INTEGER IH
      INTEGER IK
      INTEGER IL
      INTEGER MULT
      INTEGER IERR
      INTEGER NVALS
      INTEGER NUMSPOTS
      REAL VALUES(5)
      REAL XD
      REAL YD
      REAL ALAM
      REAL DTHR2
      CHARACTER*80 STR
      CHARACTER*80 WARNSTR
      CHARACTER*80 ERRSTR
C
C-------------------------------------------------------------------------------
C
      IF (IUN_DIAG.LE.0) RETURN
      IF (IUN_LOG.LE.0) RETURN
      CALL LRL_NUMSPOTS (NUMSPOTS)
      FIRST = .TRUE.
      REWIND IUN_DIAG
 10   READ (IUN_DIAG, '(A)', END=500) STR
      IF (STR.EQ.' ') GO TO 10
      CALL STRVAL (STR, ' ,', 5, VALUES, NVALS)
      IF (NVALS.LT.5) THEN
         WARNSTR = 
     +    '*Warning* Incomplete line in diagnostics file ignored'
         CALL LOGSTR (IUN_LOG, WARNSTR, 1)
         CALL LOGSTR (IUN_LOG, STR, 1)
         GO TO 10
      END IF
      IPK = NINT(VALUES(1))      
      IPL = NINT(VALUES(2))
      JH = NINT(VALUES(3))
      JK = NINT(VALUES(4))
      JL = NINT(VALUES(5))
      IF (IPK.EQ.IPACK.AND.IPL.EQ.IPLATE) THEN
         IF (FIRST) THEN
            CALL LOG_HEAD (IUN_LOG,'Diagnostic spots',2)
            FIRST = .FALSE.
            CALL LOGSTR (IUN_LOG, ' ', 1)
         ELSE  
            CALL LOGSTR (IUN_LOG, ' ', 2)
         END IF
         IF (NUMSPOTS.EQ.0) THEN
            WARNSTR = '*Warning* Diagnostic spot'
            CALL STR_ADDI (WARNSTR, JH, 1)
            CALL STR_ADDI (WARNSTR, JK, 1)
            CALL STR_ADDI (WARNSTR, JL, 1)
            CALL STR_ADDS (WARNSTR, '- no spots in list', 1)
            CALL LOGSTR (IUN_LOG, WARNSTR, 1)
            GO TO 10
         END IF
         KSPOT = 0
         DO 50 ISPOT = 1, NUMSPOTS
            CALL LRL_GET (ISPOT, IH, IK, IL, XD, YD, ALAM, DTHR2,
     +                    MULT, OKNOD, SPOV, IERR)
            IF (IH.EQ.JH.AND.IK.EQ.JK.AND.IL.EQ.JL) THEN
               KSPOT = ISPOT
               GO TO 100
            END IF
 50      CONTINUE
         WARNSTR = '*Warning* Diagnostic spot'
         CALL STR_ADDI (WARNSTR, JH, 1)
         CALL STR_ADDI (WARNSTR, JK, 1)
         CALL STR_ADDI (WARNSTR, JL, 1)
         CALL STR_ADDS (WARNSTR, 'not found in spot list', 1)
         CALL LOGSTR (IUN_LOG, WARNSTR, 1)
         GO TO 10
 100     CALL LFN_SAINT (IPACK, IPLATE, 10+KSPOT, IMG, ITYPE, IORD,
     +                   NFRASTS, NXRAST, NYRAST, PROMIN, 
     +                   NTHE, PROF_ROT, NOVLD,
     +                   LFN_SOFT_PROG, LFN_DUMMY_CNCL, IERR, ERRSTR)
         IF (IERR.NE.0) THEN
            STR = '**Error** Integration routine error'
            CALL LOGSTR (IUN_LOG, STR, 1)
            CALL LOGSTR (IUN_LOG, ERRSTR, 1)
            GO TO 10
         END IF
         CALL LFN_LIST_INTSPOT (IUN_LOG, 0, .TRUE., .TRUE., .TRUE., 
     +                          .TRUE., IERR, ERRSTR)
         IF (IERR.NE.0) THEN
            STR = '**Error** Integration spot listing error'
            CALL LOGSTR (IUN_LOG, STR, 1)
            CALL LOGSTR (IUN_LOG, ERRSTR, 1)
            GO TO 10
         END IF
         GO TO 10
      END IF
      GO TO 10
C
C====== End of file reached
C
 500  RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*******************
C**     LJUST     **
C*******************
C
C
      SUBROUTINE LJUST (CHSTR)
C
C Purpose:    Left jusify text in a character string (eliminate leading blanks)
C
C Author:     John W. Campbell, September 1990
C
C Arguments:
C
      CHARACTER*(*) CHSTR
C
C    CHSTR  (M)  Character string containing the text
C
C Declarations
C ============
C
C GLOBALS:
C

C
C LOCALS:
C
      INTEGER NC
      INTEGER I

C     INTEGER NC   !No. of characters in the string
C     INTEGER I    !Loop counter
C
C-------------------------------------------------------------------------------
C
C====== Shift as needed
C
      NC = LEN (CHSTR)
      DO 100 I = 1, NC
         IF (CHSTR(I:I).NE.' ') THEN
            CHSTR = CHSTR(I:NC)
            RETURN
         ENDIF
100   CONTINUE
      RETURN
      END
