CD-Title: Laue Scaling Module (LSM) Routines
CD-end

CD-Intro:
C These are sets of routines which provide some machine independent functions
C for implementing the Laue Scaling Module (LSM). The LSM routines are
C designed so that they can be used in a number of different contexts
C including that of the Laue Data Module (LDM). Also included are an 
C associated set of Laue Scaling Parameter (LSP) routines designed to form 
C the basis of a stand-alone Laue scaling, normalisation and absorption 
C correction program.
CD-end

CD-Section: Setting up the Laue Scaling Module (LSM)
C Routines are available to set up the LSM scaling parameters and related
C data prior to using the other LSM based routines provided. LSM_KEYSETUP
C needs to be called to set up the LSM keyworded scaling parameters,
C LSM_PARSETUP (or an associated routine) needs to be called to set up
C other parameters required by the LSM routines and LSM_KDMCOPY needs
C to be called to copy the read in LSM parameter values to a set of
C internal scaling arrays (SCP) used by the LSM routines.
CD-end
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C
C**************************
C**     LSM_KEYSETUP     **
C**************************
C
C
CD-Routine: Set up keyworded parameters - LSM_KEYSETUP
C This routine defines the LSM (Laue Scaling Module) set of keyworded
C parameters. These are considered to be a set of parameters to be
C used in addition to some other keyworded set of parameters (e.g.
C an LDM set of parameters) which contains parameters such as the
C number of packs and plates, symmetry, crystal to image distances
C and spindle angles etc. (Values of such parameters will be passed
C to the LSM using a routine such as LSM_PARSETUP, again prior to
C using the other sets of LSM routines)
CD-end
CD-Fortran:  
      SUBROUTINE LSM_KEYSETUP (KDX) 
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C
C Purpose: Set up LSM keywords
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER KDX
C
CD-Parameters:
C  KDX         i (R)   The index of the keyword set to which the LSM
C                      keyworded scaling parameters are to be added)
CD-end
C
C Implementation notes: Sets 'markup-required' flag
C                       Saves KINDX for internal use by LSM routines
C
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'lsm_flags.finc'
      INCLUDE 'other_scale.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER KDMSTR
      INTEGER LENSTR
      EXTERNAL LSM_CHECK_MU
      INTEGER LSM_CHECK_MU
C
C====== LOCALS:
C
      INTEGER I, J, K
      INTEGER IERR
      INTEGER ISTD
      INTEGER I_DEFLT(MAXVARR)
      INTEGER IRTYP(MAXVARR)
      INTEGER ND(MAXVARR)
      INTEGER ND_DEFLT(MAXVARR)
      INTEGER POLTYPSTRLEN(2)
      REAL F_DEFLT(MAXVARR)
      CHARACTER*80 STR
      CHARACTER*7  POL_TYPE_OPT(2)
      REAL POLFAC_DEFLT
      REAL NORM_LAMREF_DEFLT	
      REAL ABSCOR_THICK_DEFLT
      REAL COVER_FAC_DEFLT
      REAL ABSMU_DEFLT(2*MAXMU)

C     INTEGER I, J, K, L           ! Temp/loop variables
C     INTEGER  IERR                ! Error return flag
C     INTEGER ISTD                 ! Standard parameter flag
C     INTEGER I_DEFLT(MAXVARR)     ! Default integer value
C     INTEGER IRTYP(MAXVARR)       ! Integer/Real flags for coefficients
C     INTEGER ND(MAXVARR)          ! No. decimal places flags
C     INTEGER ND_DEFLT(MAXVARR)    ! No. decimal places default flags
C     INTEGER POLTYPSTRLEN(2)      ! Length of rad.type strings
C     REAL F_DEFLT(MAXVARR)        ! Default real value(s)
C     CHARACTER*80 STR             ! Temporary string
C     CHARACTER*7  POL_TYPE_OPT(2) ! Radiation types for polarisation
C     REAL POLFAC_DEFLT            ! Polarisation factor default
C     REAL NORM_LAMREF_DEFLT       ! Default reference wavelength for 
C				     Chebychev-Polynomials		
C     REAL ABSCOR_THICK_DEFLT      ! Reference crystal thickness in
C				     absorption correction (mm)	
C     REAL COVER_FAC_DEFLT         ! Factor to take account of front
C                                    sheet(s).
C     REAL ABSMU_DEFLT(2*MAXMU)    ! Parameters used in determining the
C                                  ! wavelength dependent linear
C                                  ! absorption coefficient used in the
C                                  ! absorption correction
C
      DATA NORM_LAMREF_DEFLT/1.0/	
      DATA ABSCOR_THICK_DEFLT/1.0/	
      DATA COVER_FAC_DEFLT/0.0/
      DATA POL_TYPE_OPT/'xray','neutron'/
      DATA POLTYPSTRLEN/4,7/
      DATA POLFAC_DEFLT/1.0/
C
C-------------------------------------------------------------------------------
C
C====== Save KDM index and set 'markup-required' flag
C
      KINDX = KDX
      MARKUP_REQUIRED = .TRUE.

C
C====== Define parameters
C      
      STR = 'POL_TYPE'	
      CALL KDMF_DEFINE_STR (KDX, KDMSTR(STR), LENSTR(STR), 5, 1, 1, 7,
     +                      KDMSTR(POL_TYPE_OPT(1)), 4, 
     +                      KDMSTR(POL_TYPE_OPT), 2, 7, 1, -2, 0, IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'POL_FAC'	
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 5, 1, 1, 1,
     +                       POLFAC_DEFLT, 0.0, 0.0, 2, 0, 2, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'COVER_FACTOR'
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 7, 1, 1, 1,
     +                       COVER_FAC_DEFLT, 0.0, 0.0, 1, 0, 2, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      DO 90 K = 1, MAXRANGE
      	       STR = 'PLATE_SCALE_'
               CALL STR_ADDI(STR,K,0)
    	       F_DEFLT(1) = 0.0
               F_DEFLT(2) = 0.0
               F_DEFLT(3) = 1.0
      	       F_DEFLT(4) = 0.0
      	       CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 
     +			     LENSTR(STR), 3, 0, 4,
     +                       F_DEFLT, 0.0, 0.0, 0, 0, -2, 2,
     +                       IERR)
               IF (IERR.NE.0) GOTO 810
90    CONTINUE

      STR = 'IMAGE_SCALE'
      F_DEFLT(1) = 1.0
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 8, 2, 1, 1,
     +                       F_DEFLT, 0.0, 0.0, 1, 0, 4, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'IMAGE_BFAC'
      F_DEFLT(1) = 0.0
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 8, 2, 1, 1,
     +                       F_DEFLT, 0.0, 0.0, 0, 0, 4, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'REFSET_SCALE'	
      F_DEFLT(1) = 1.0
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 8, 1, 1, 1,
     +                       F_DEFLT, 0.0, 0.0, 2, 0, 4, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'REFSET_BFAC'	
      F_DEFLT(1) = 0.0
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 8, 1, 1, 1,
     +                       F_DEFLT, 0.0, 0.0, 0, 0, 4, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'NORM_LAMREF'	
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 6, 1, 1, 1,
     +                       NORM_LAMREF_DEFLT, 0.0, 0.0, 2, 0, 2, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      DO 80 I = 1, MAXRANGE
         ISTD = 1
         IF (I.GT.1) ISTD = 0
	 STR = 'NORM_COEFF_'
	 CALL STR_ADDI(STR,I,0)
         I_DEFLT(1) = 0
         IF (I.EQ.1) THEN
            F_DEFLT(2) = 0.5 
            F_DEFLT(3) = 1.5 
         ELSE
            F_DEFLT(2) = 0.0 
            F_DEFLT(3) = 0.0 
         END IF
         F_DEFLT(4) = 2.0
         ND(1) = 0
         ND(2) = 3
         ND(3) = 3
         ND(4) = -5
         ND_DEFLT(1) = 0
         ND_DEFLT(2) = 1
         ND_DEFLT(3) = 1
         ND_DEFLT(4) = 1
         DO 40 J = 5, POLCOEFFS+3
            F_DEFLT(J) = 0.0
            ND(J) = -5
            ND_DEFLT(J) = 1
40       CONTINUE
         IRTYP(1) = 1
         DO 30 K = 2, POLCOEFFS+3
      	    IRTYP(K) = 2
30       CONTINUE
         CALL KDMF_DEFINE_VARR (KDX, KDMSTR(STR), LENSTR(STR),
     +			     LENSTR(STR), 1, ISTD, POLCOEFFS+3,
     +			     4, I_DEFLT, F_DEFLT, IRTYP,
     +			     0, 0, ND, ND_DEFLT, 4, IERR)   		
         IF (IERR.NE.0) GOTO 810
80    CONTINUE	
      
      STR = 'ABSCOR_LAMREF'	
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 8, 1, 1, 1,
     +                       NORM_LAMREF_DEFLT, 0.0, 0.0, 2, 0, 2, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'ABSCOR_MU'	
      DO 120 I = 1, 2*MAXMU
         ABSMU_DEFLT(I) = 0.0
         ND(I) = 2
         ND_DEFLT(I) = 1
      	 IRTYP(I) = 2
 120  CONTINUE   
      ABSMU_DEFLT(1) = 1.0
      CALL KDMF_DEFINE_VARR (KDX, KDMSTR(STR), LENSTR(STR), 8, 1, 1, 
     +                       2*MAXMU, 1, I_DEFLT, ABSMU_DEFLT, IRTYP,
     +                      1, LSM_CHECK_MU, ND, ND_DEFLT, 1, IERR)
      IF (IERR.NE.0) GOTO 810

      STR = 'ABSCOR_THICK'	
      CALL KDMF_DEFINE_FLOAT (KDX, KDMSTR(STR), LENSTR(STR), 8, 2, 1, 1,
     +                       ABSCOR_THICK_DEFLT, 0.0, 0.0, 2, 0, 2, 2,
     +                       IERR)
      IF (IERR.NE.0) GOTO 810
 
      STR = 'ABSCOR_LOCAL'
      I_DEFLT(1) = 0
      I_DEFLT(2) = 0
      ND(1) = 0
      ND(2) = 0
      ND_DEFLT(1) = 0
      ND_DEFLT(2) = 0
      DO 50 J = 3, 6
         ND(J) = 2
         ND_DEFLT(J) = 1
50    CONTINUE	
      DO 20 J = 7, MAXCOEFFS+6
         ND(J) = -5
         ND_DEFLT(J) = 1
20    CONTINUE	
      DO 130 I = 3, 6
         F_DEFLT(I) = 0.0
 130  CONTINUE
      IRTYP(1) = 1
      IRTYP(2) = 1
      DO 110 K = 3, MAXCOEFFS+6
         IRTYP(K) = 2
110   CONTINUE
      CALL KDMF_DEFINE_VARR (KDX, KDMSTR(STR), LENSTR(STR),
     +			     8, 2, 1, MAXCOEFFS+6,
     +			     6, I_DEFLT, F_DEFLT, IRTYP,
     +			     0, 0, ND, ND_DEFLT, 6, IERR)   		
      IF (IERR.NE.0) GOTO 810

      STR = 'ABSCOR_GLOBAL'
      I_DEFLT(1) = 1
      I_DEFLT(2) = 0
      I_DEFLT(3) = 0
      ND(1) = 0
      ND(2) = 0
      ND(3) = 0
      ND_DEFLT(1) = 0
      ND_DEFLT(2) = 0
      ND_DEFLT(3) = 0
      DO 10 I = 4, MAXCOEFFS+7	
      	 F_DEFLT(I) = 0.0
10    CONTINUE	
      DO 100 I = 1, 3	
         IRTYP(I) = 1
100   CONTINUE
      DO 140 I = 4, MAXCOEFFS+7
         IRTYP(I) = 2
         ND(I) = -5
         ND_DEFLT(I) = 1
140   CONTINUE
      CALL KDMF_DEFINE_VARR (KDX, KDMSTR(STR), LENSTR(STR),
     +			     8, 1, 1, MAXCOEFFS+7,
     +			     3, I_DEFLT, F_DEFLT, IRTYP,
     +			     0, 0, ND, ND_DEFLT, 7, IERR)   		
      IF (IERR.NE.0) GOTO 810

      RETURN
C
C====== Fatal (Programming) Error
C
 810  WRITE(6,2002) IERR, STR(1:LENSTR(STR))
      WRITE(6,2000)
      STOP
C
C====== Format statements
C
 2002 FORMAT (/,'***  ERROR  *** ',/,' ERROR CODE ',I2,
     +        ' FROM READING KEYWORD PARAMETERS IN LSM_KEYSETUP:',
     +        /,' ',A)
 2000 FORMAT (//,' ******** PROCESSING STOPPED *******')

      END
