C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GENLDM           **
C**************************
C
C
C      IMPLICIT NONE
C
C Purpose: Convert a .gen file to an LDM data file as best as possible
C
C Author:  John W. Campbell, October 1993
C
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      LOGICAL CCPEXS
      INTEGER NXTTOK
      INTEGER INTFP
C
C====== LOCALS:
C
      LOGICAL QUIT
      LOGICAL EXISTS
      INTEGER I
      INTEGER J
      INTEGER IERR
      INTEGER IFAIL
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER IV
      INTEGER NCLL
      INTEGER IUN_GEN
      INTEGER IUN_OUT
      INTEGER IEND
      INTEGER ISYST
      INTEGER LATT
      INTEGER IROT
      INTEGER IBEAM
      INTEGER NXRAST
      INTEGER NYRAST
      INTEGER NFID
      INTEGER IFLIP
      INTEGER DISTOR_TYPE
      INTEGER N1OD
      REAL CELL_IN(6)
      REAL PHIS(3)
      REAL SPINDLE
      REAL WMIN
      REAL WMAX
      REAL WSTD
      REAL DMIN
      REAL CTOF
      REAL FILMR
      REAL X_CEN_IN
      REAL Y_CEN_IN
      REAL X_C
      REAL Y_C
      REAL W_C
      REAL TWIST
      REAL TILT
      REAL BULGE
      REAL ROFF
      REAL TOFF
      REAL XREJ
      REAL YREJ
      REAL WFILM
      REAL FIDBOX
      REAL BASEOD
      REAL G1OD
      REAL CURV
      REAL DSCAL
      REAL XLOW
      REAL XHIGH
      REAL YLOW
      REAL YHIGH
      
      REAL    FP
      REAL    CLL(6)
      REAL    CELLX(6)
      REAL    Y_SCALE
      REAL    FIDX1
      REAL    FIDY1
      REAL    FIDX2
      REAL    FIDY2
      REAL    FIDX3
      REAL    FIDY3
      REAL    RASTSIZ
      CHARACTER*120 FILOUT
      CHARACTER*120 GEN_FILE
      CHARACTER*120 STR
      CHARACTER*2 ERRSTR

C     LOGICAL QUIT            !Quit program flag
C     LOGICAL EXISTS          !File exists flag
C     INTEGER I               !Temp/loop variable
C     INTEGER J               !Temp/loop variable
C     INTEGER IERR            !Error flag
C     INTEGER IFAIL           !File open error flag
C     INTEGER IL              !Character counter for NXTTOK routine
C     INTEGER M1              !Start of field found by NXTTOK
C     INTEGER M2              !End of field found by NXTTOK
C     INTEGER IV              !Integer value returned from INTFP
C     INTEGER NCLL            !No. of cell parameters read (GT_ORIENT)
C     REAL    FP              !Real value returned from INTFP
C     REAL    CLL(6)          !Cell parameters returned from GT_ORIENT (<=6)
C     REAL    CELLX(6)        !Expanded reciprocal cell parameters (6)
C     REAL    Y_SCALE         !Scanner parameter
C     REAL    FIDX1           !Input fid x1 in 10mu from image halfway x
C     REAL    FIDY1           !Input fid y1 in 10mu from image halfway y
C     REAL    FIDX2           !Input fid x2 in 10mu from image halfway x
C     REAL    FIDY2           !Input fid y2 in 10mu from image halfway y
C     REAL    FIDX3           !Input fid x3 in 10mu from image halfway x
C     REAL    FIDY3           !Input fid y3 in 10mu from image halfway y
C     REAL    RASTSIZ         !Raster size as read in
C     CHARACTER*120 FILOUT    !Output file name
C     CHARACTER*120 GEN_FILE  !.gen file name
C     CHARACTER*120 STR       !Record read from .gen file
C     CHARACTER*2 ERRSTR      !Error string (dummy)
C

C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      IUN_GEN = 1
      IUN_OUT = 2
      CALL TRWSET (5, 6, 0, 0, 0)
C
C====== Read in .gen file name
C
10    CALL TPROMP('Name of input .gen file (default ext=.gen): ')
      CALL TREAD(STR,QUIT)
      IF (QUIT) STOP
      CALL FILEXT(STR,'gen',GEN_FILE,IEND)
      IF (.NOT.CCPEXS(GEN_FILE)) THEN
         CALL TWRITE('**Error** .gen file does not exist')
         GO TO 10
      END IF
      IFAIL = 1
      CALL CCPDPN (-IUN_GEN, GEN_FILE, 'READONLY', 'F', 0, IFAIL)
      IF (IFAIL.LT.0) THEN
         CALL TWRITE ('**Error in opening file**')
         GO TO 10
      END IF
      
C
C====== Get name of output file
C
 20   CALL TPROMP('Name of output .ldm file (default ext=.ldm): ')
      CALL TREAD(STR,QUIT)
      IF (QUIT) STOP
      CALL FILEXT(STR,'ldm',FILOUT,I)
      IFAIL = 0
      CALL CCPDPN(-IUN_OUT,FILOUT,'NEW','F',0,IFAIL)
      IF (IFAIL.NE.0) THEN
         CALL TWRITE('**Error** Unable to open output file')
         GO TO 20
      END IF
C
C====== Read title and crystal id

      READ (IUN_GEN, 1000, END=800) STR
      CALL LDM_SET_TITLE (STR, IERR, ERRSTR)
     
      READ (IUN_GEN, 1000, END=800) STR
      CALL LDM_SET_CRYST (STR, IERR, ERRSTR)
C
C====== Read cell and orientation parameters
C
      READ (IUN_GEN, 1000, END=800) STR
      CALL GT_ORIENT (STR, CLL, NCLL, ISYST, LATT, IROT, IBEAM, IERR)
      IF (IERR.NE.0) THEN
         CALL TWRITE ('**Error in orientation data record**')
         CALL TWRITE ('**Reading of .gen file abandoned**')
         CLOSE (IUN_GEN)
         CLOSE (IUN_OUT)
         STOP
      END IF
      CALL LDM_SET_SYST (' ', ISYST, IERR, ERRSTR)
      CALL LDM_SET_LATT (' ', LATT, IERR, ERRSTR)
      CALL LDM_SET_BEAM (' ', IBEAM, IERR, ERRSTR)
      CALL LDM_SET_ROT (' ', IROT, IERR, ERRSTR)
      CALL CELLCX (ISYST, CLL, CELLX, 1, 2)
      CALL RECCEL (CELL_IN, CELLX, 1.0)
      CALL LDM_SET_A (CELL_IN(1), IERR, ERRSTR)
      CALL LDM_SET_B (CELL_IN(2), IERR, ERRSTR)
      CALL LDM_SET_C (CELL_IN(3), IERR, ERRSTR)
      CALL LDM_SET_ALPHA (CELL_IN(4), IERR, ERRSTR)
      CALL LDM_SET_BETA (CELL_IN(5), IERR, ERRSTR)
      CALL LDM_SET_GAMMA (CELL_IN(6), IERR, ERRSTR)
C
C====== Read Phi's
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), PHIS(1), IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in PhiX**')
            CALL TWRITE ('**PhiX set to 0.0**')
            PHIS(1) = 0.0
         END IF
      ELSE
         PHIS(1) = 0.0
      END IF
      CALL LDM_SET_PHIX (0, PHIS(1), IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), PHIS(2), IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in PhiY**')
            CALL TWRITE ('**PhiY set to 0.0**')
            PHIS(2) = 0.0
         END IF
      ELSE
         PHIS(2) = 0.0
      END IF
      CALL LDM_SET_PHIY (0, PHIS(2), IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), PHIS(3), IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in PhiZ**')
            CALL TWRITE ('**PhiZ set to 0.0**')
            PHIS(3) = 0.0
         END IF
      ELSE
         PHIS(3) = 0.0
      END IF
      CALL LDM_SET_PHIZ (0, PHIS(3), IERR, ERRSTR)
C
C====== Wavelengths
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), WMIN, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in wmin**')
         END IF
      ELSE
         WMIN = 0.0
      END IF
      IF (WMIN.LE.0.0) THEN
         CALL TWRITE ('**Non positive wmin reset to 0.25**')
         WMIN = 0.25
      END IF
      CALL LDM_SET_LMIN (0, WMIN, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), WMAX, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in wmax**')
         END IF
      ELSE
         WMAX = 0.0
      END IF
      IF (WMAX.LE.0.0) THEN
         CALL TWRITE ('**Non positive wmax reset to 2.5**')
         WMAX = 2.5
      END IF
      CALL LDM_SET_LMAX (0, WMAX, IERR, ERRSTR)
C
C====== Ctof
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), CTOF, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in ctof**')
         END IF
      ELSE
         CTOF = 0.0
      END IF
      IF (CTOF.LE.0.0) THEN
         CALL TWRITE ('**Non positive ctof reset to 60.0**')
         CTOF = 60.0
      END IF
      CALL LDM_SET_SPAC (0, 0, 0.22, IERR, ERRSTR)
      CALL LDM_SET_CTOF (0, 0, CTOF, IERR, ERRSTR)
C
C====== dmin, filmr
C
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), DMIN, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in dmin**')
         END IF
      ELSE
         DMIN = 0.0
      END IF
      IF (DMIN.LE.0.0) THEN
         CALL TWRITE ('**Non positive dmin reset to 1.5**')
         DMIN = 1.5
      END IF
      CALL LDM_SET_DMIN (0, DMIN, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FILMR, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in filmr**')
         END IF
      ELSE
         FILMR = 0.0
      END IF
      IF (FILMR.LE.0.0) THEN
         CALL TWRITE ('**Non positive filmr reset to 59.0**')
         FILMR = 59.0
      END IF
      CALL LDM_SET_RMAX (FILMR, IERR, ERRSTR)
C
C====== Spindle
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), SPINDLE, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in spindle**')
            CALL TWRITE ('**spindle reset to 0.0**')
            SPINDLE = 0.0
         END IF
      ELSE
         SPINDLE = 0.0
      END IF
      CALL LDM_SET_SPIN (0, SPINDLE, IERR, ERRSTR)
C
C====== X_c, y_c, w_c
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), X_C, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in x_c**')
            CALL TWRITE ('**x_c reset to 0.0**')
            X_C = 0.0
         END IF
      ELSE
         X_C = 0.0
      END IF
      CALL LDM_SET_XC (0, 0, X_C, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), Y_C, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in y_c**')
            CALL TWRITE ('**y_c reset to 0.0**')
            Y_C = 0.0
         END IF
      ELSE
         Y_C = 0.0
      END IF
      CALL LDM_SET_YC (0, 0, Y_C, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), W_C, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in w_c**')
            CALL TWRITE ('**w_c reset to 0.0**')
            W_C = 0.0
         END IF
      ELSE
         W_C = 0.0
      END IF
      CALL LDM_SET_WC (0, 0, W_C, IERR, ERRSTR)
C
C====== Twist, tilt, bulge (or twist, tilt, roff, toff)
C
      READ (IUN_GEN, 1000, END=800) STR
      DISTOR_TYPE = 1
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) DISTOR_TYPE = 2
      CALL LDM_SET_DSTOR (' ', DISTOR_TYPE, IERR, ERRSTR)
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), TWIST, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in twist**')
            CALL TWRITE ('**twist reset to 0.0**')
            TWIST = 0.0
         END IF
      ELSE
         TWIST = 0.0
      END IF
      CALL LDM_SET_TWIST (0, 0, TWIST, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), TILT, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in tilt**')
            CALL TWRITE ('**tilt reset to 0.0**')
            TILT = 0.0
         END IF
      ELSE
         TILT = 0.0
      END IF
      CALL LDM_SET_TILT (0, 0, TILT, IERR, ERRSTR)
      IF (DISTOR_TYPE.EQ.1) THEN
         I = NXTTOK (STR, ' ,', IL, M1, M2)
         IF (I.GT.0) THEN
            J = INTFP (STR(M1:M2), BULGE, IV)
            IF (J.EQ.0) THEN
               CALL TWRITE ('**Syntax error in bulge**')
               CALL TWRITE ('**bulge reset to 0.0**')
               BULGE = 0.0
            END IF
         ELSE
            BULGE = 0.0
         END IF
         CALL LDM_SET_BULGE (0, 0, BULGE, IERR, ERRSTR)

      ELSE

         I = NXTTOK (STR, ' ,', IL, M1, M2)
         IF (I.GT.0) THEN
            J = INTFP (STR(M1:M2), ROFF, IV)
            IF (J.EQ.0) THEN
               CALL TWRITE ('**Syntax error in roff**')
               CALL TWRITE ('**roff reset to 0.0**')
               ROFF = 0.0
            END IF
         ELSE
            ROFF = 0.0
         END IF
         CALL LDM_SET_ROFF (0, 0, ROFF, IERR, ERRSTR)

         I = NXTTOK (STR, ' ,', IL, M1, M2)
         IF (I.GT.0) THEN
            J = INTFP (STR(M1:M2), TOFF, IV)
            IF (J.EQ.0) THEN
               CALL TWRITE ('**Syntax error in toff**')
               CALL TWRITE ('**toff reset to 0.0**')
               TOFF = 0.0
            END IF
         ELSE
            TOFF = 0.0
         END IF
         CALL LDM_SET_TOFF (0, 0, TOFF, IERR, ERRSTR)
      END IF
C
C====== Yscale
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), Y_SCALE, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in yscale**')
         END IF
      ELSE
         Y_SCALE = 0.0
      END IF
      IF (Y_SCALE.LE.0.0) THEN
         CALL TWRITE ('**Non positive yscale reset to 1.0**')
         Y_SCALE = 1.0
      END IF
      CALL LDM_SET_YSCAL (0, 0, Y_SCALE, IERR, ERRSTR)
C
C====== Xrej, yrej
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), XREJ, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in xrej**')
         END IF
      ELSE
         XREJ = 0.0
      END IF
      IF (XREJ.LT.0.0) THEN
         CALL TWRITE ('**Negative xrej reset to 0.0**')
         XREJ = 0.0
      END IF

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), YREJ, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in yrej**')
         END IF
      ELSE
         YREJ = 0.0
      END IF
      IF (YREJ.LT.0.0) THEN
         CALL TWRITE ('**Negative yrej reset to 0.0**')
         YREJ = 0.0
      END IF
      IF (XREJ.GT.0.0.AND.YREJ.EQ.0.0) THEN
         CALL LDM_SET_RMIN (XREJ, IERR, ERRSTR)
      END IF
      IF (XREJ.GT.0.0.AND.YREJ.GT.0.0) THEN
         CALL TWRITE ('*Setting rmin to (xrej+yrej)/4*')
         CALL LDM_SET_RMIN ((XREJ+YREJ)/4.0, IERR, ERRSTR)
      END IF
C
C====== Fids
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FP, NFID)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in nfid**')
         END IF
         IF (J.EQ.2) THEN
            CALL TWRITE ('**nfid set to nearest integer**')
         END IF
      ELSE
         NFID = 0
      END IF
      IF (NFID.NE.0.AND.NFID.NE.3) THEN
         CALL TWRITE (
     +        '**Invalid value for nfid reset to 0**')
         NFID = 0
      END IF
      IF (NFID.GT.0) THEN
         CALL LDM_SET_FIDT (' ', 1, IERR, ERRSTR)
      ELSE
         CALL LDM_SET_FIDT (' ', 0, IERR, ERRSTR)
      END IF

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDX1, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidx1**')
            IF (NFID.EQ.3) THEN
               CALL TWRITE ('**fidx1 reset to -5000.0**')
               FIDX1 = -5000.0
            ELSE
               CALL TWRITE ('**fid_in_x1 reset to 0.0**')
               FIDX1 = 0.0
            END IF
         END IF
      ELSE
         FIDX1 = 0.0
      END IF
      CALL LDM_SET_FIDX1 (FIDX1, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDY1, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidy1**')
            IF (NFID.EQ.3) THEN
               CALL TWRITE ('**fidy1 reset to -4000.0**')
               FIDY1 = -4000.0
            ELSE
               CALL TWRITE ('**fidy1 reset to 0.0**')
               FIDY1 = 0.0
            END IF
         END IF
      ELSE
         FIDY1 = 0.0
      END IF
      CALL LDM_SET_FIDY1 (FIDY1, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDX2, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidx2**')
            IF (NFID.EQ.3) THEN
               CALL TWRITE ('**fidx2 reset to -5000.0**')
               FIDX2 = -5000.0
            ELSE
               CALL TWRITE ('**fidx2 reset to 0.0**')
               FIDX2 = 0.0
            END IF
         END IF
      ELSE
         FIDX2 = 0.0
      END IF
      CALL LDM_SET_FIDX2 (FIDX2, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDY2, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidy2**')
            IF (NFID.EQ.3) THEN
               CALL TWRITE ('**fidy2 reset to 4000.0**')
               FIDY2 = 4000.0
            ELSE
               CALL TWRITE ('**fidy2 reset to 0.0**')
               FIDY2 = 0.0
            END IF
         END IF
      ELSE
         FIDY2 = 0.0
      END IF
      CALL LDM_SET_FIDY2 (FIDY2, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDX3, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidx3**')
            IF (NFID.EQ.3) THEN
               CALL TWRITE ('**fidx3 reset to 5000.0**')
               FIDX3 = 5000.0
            ELSE
               CALL TWRITE ('**fidx3 reset to 0.0**')
               FIDX3 = 0.0
            END IF
         END IF
      ELSE
         FIDX3 = 0.0
      END IF
      CALL LDM_SET_FIDX3 (FIDX3, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDY3, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidy3**')
            IF (NFID.EQ.3) THEN
               CALL TWRITE ('**fidy3 reset to 4000.0**')
               FIDY3 = 4000.0
            ELSE
               CALL TWRITE ('**fidy3 reset to 0.0**')
               FIDY3 = 0.0
            END IF
         END IF
      ELSE
         FIDY3 = 0.0
      END IF
      CALL LDM_SET_FIDY3 (FIDY3, IERR, ERRSTR)
C
C====== Film constants
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), WFILM, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in wfilm**')
            CALL TWRITE ('**wfilm reset to 0.0**')
            WFILM = 0.0
         END IF
      ELSE
         WFILM = 0.0
      END IF

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FIDBOX, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in fidbox**')
            CALL TWRITE ('**fidbox reset to 5.0**')
            FIDBOX = 5.0
         END IF
      ELSE
         FIDBOX = 0.0
      END IF
      IF (FIDBOX.LE.0) THEN
         CALL TWRITE ('**Non positive fidbox reset to 5.0**')
         FIDBOX = 5.0
      END IF
      CALL LDM_SET_FBOX (FIDBOX, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FP, N1OD)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in n1od**')
            CALL TWRITE ('**n1od reset to 128**')
            N1OD = 128
         END IF
         IF (J.EQ.2) THEN
            CALL TWRITE ('**n1od set to nearest integer**')
         END IF
      ELSE
         N1OD = 0
      END IF
      CALL LDM_SET_N1OD (N1OD, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), BASEOD, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in baseod**')
            CALL TWRITE ('**baseod reset to 0.04**')
            BASEOD = 0.04
         END IF
      ELSE
         BASEOD = 0.0
      END IF
      CALL LDM_SET_BASE (BASEOD, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), G1OD, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in g1od**')
            CALL TWRITE ('**g1od reset to 2.3**')
            G1OD = 2.3
         END IF
      ELSE
         G1OD = 0.0
      END IF
      CALL LDM_SET_G1OD (G1OD, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), CURV, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in curv**')
            CALL TWRITE ('**curv reset to 0.07**')
            CURV = 0.07
         END IF
      ELSE
         CURV = 0.0
      END IF
      CALL LDM_SET_NONL (CURV, IERR, ERRSTR)
C
C====== Rasters, input centre, raster size, 
C====== x,y limits and film/image-plate indicator
C
      READ (IUN_GEN, 1000, END=800) STR
      IL = 0
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FP, NXRAST)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in nxrast**')
            CALL TWRITE ('**nxrast reset to 2400**')
            NXRAST = 2400
         END IF
         IF (J.EQ.2) THEN
            CALL TWRITE ('**nxrast set to nearest integer**')
         END IF
      ELSE
         NXRAST = 0
      END IF
      CALL LDM_SET_NXRAS (NXRAST, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), FP, NYRAST)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in nyrast**')
            CALL TWRITE ('**nyrast reset to 2400**')
            NYRAST = 2400
         END IF
         IF (J.EQ.2) THEN
            CALL TWRITE ('**nyrast set to nearest integer**')
         END IF
      ELSE
         NYRAST = 0
      END IF
      CALL LDM_SET_NYRAS (NYRAST, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), DSCAL, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in dscal**')
         END IF
      ELSE
         DSCAL = 0.0
      END IF

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), X_CEN_IN, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in x_cen_in**')
            CALL TWRITE ('**x_cen_in reset to 0.0**')
            X_CEN_IN = 0.0
         END IF
      ELSE
         X_CEN_IN = 0.0
      END IF
      IF (X_CEN_IN.LT.0.0) THEN
         CALL TWRITE ('**Negative x_cen_in reset to 0.0**')
         X_CEN_IN = 0.0
      END IF
      CALL LDM_SET_XCENF (0, 0, X_CEN_IN, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), Y_CEN_IN, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in y_cen_in**')
            CALL TWRITE ('**y_cen_in reset to 0.0**')
            Y_CEN_IN = 0.0
         END IF
      ELSE
         Y_CEN_IN = 0.0
      END IF
      IF (Y_CEN_IN.LT.0.0) THEN
         CALL TWRITE ('**Negative y_cen_in reset to 0.0**')
         Y_CEN_IN = 0.0
      END IF
      CALL LDM_SET_YCENF (0, 0, Y_CEN_IN, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), RASTSIZ, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in rastsiz**')
            CALL TWRITE ('**rastsiz reset to 50.0**')
            RASTSIZ = 50.0
         END IF
      ELSE
         RASTSIZ = 50.0
      END IF
      CALL LDM_SET_RAST (RASTSIZ, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), XLOW, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in xlow**')
            CALL TWRITE ('**xlow reset to 0.0**')
            XLOW = 0.0
         END IF
      ELSE
         XLOW = 0.0
      END IF
      IF (XLOW.LT.0.0) THEN
         CALL TWRITE ('**Negative xlow reset to 0.0**')
         XLOW = 0.0
      END IF
      CALL LDM_SET_XLOW (XLOW, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), XHIGH, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in xhigh**')
            CALL TWRITE ('**xhigh reset to 0.0**')
            XHIGH = 0.0
         END IF
      ELSE
         XHIGH = 0.0
      END IF
      IF (XHIGH.LT.0.0) THEN
         CALL TWRITE ('**Negative xhigh reset to 0.0**')
         XHIGH = 0.0
      END IF
      CALL LDM_SET_XHIGH (XHIGH, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), YLOW, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in ylow**')
            CALL TWRITE ('**ylow reset to 0.0**')
            YLOW = 0.0
         END IF
      ELSE
         YLOW = 0.0
      END IF
      IF (YLOW.LT.0.0) THEN
         CALL TWRITE ('**Negative ylow reset to 0.0**')
         YLOW = 0.0
      END IF
      CALL LDM_SET_YLOW (YLOW, IERR, ERRSTR)

      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         J = INTFP (STR(M1:M2), YHIGH, IV)
         IF (J.EQ.0) THEN
            CALL TWRITE ('**Syntax error in yhigh**')
            CALL TWRITE ('**yhigh reset to 0.0**')
            YHIGH = 0.0
         END IF
      ELSE
         YHIGH = 0.0
      END IF
      IF (YHIGH.LT.0.0) THEN
         CALL TWRITE ('**Negative yhigh reset to 0.0**')
         YHIGH = 0.0
      END IF
      CALL LDM_SET_YHIGH (YHIGH, IERR, ERRSTR)

      IFLIP = 1
      I = NXTTOK (STR, ' ,', IL, M1, M2)
      IF (I.GT.0) THEN
         IF (STR(M1:M1).EQ.'i'.OR.STR(M1:M1).EQ.'I') IFLIP = 2
      ENDIF
      CALL LDM_SET_IMTYP (' ', IFLIP, IERR, ERRSTR)
      CALL LDM_SET_IMDAT (' ', IFLIP, IERR, ERRSTR)
      CLOSE (IUN_GEN)
C
C====== Set a few other parameters
C
      CALL LDM_SET_NUMP (1, IERR, ERRSTR)
      IF (IFLIP.EQ.1) THEN
         CALL LDM_SET_NPLAT (6, IERR, ERRSTR)
      ELSE
         CALL LDM_SET_NPLAT (1, IERR, ERRSTR)
      END IF
C
C====== Write LDM file
C
      CALL LDM_WRITE (IUN_OUT, 2)
      CLOSE (UNIT=IUN_OUT)
      STOP
C
C====== Premature end of file
C
800   CALL TWRITE ('**Premature end-of-file found**')
      CLOSE (IUN_GEN)
      CLOSE (IUN_OUT)
      STOP
C
C====== Format statements
C
1000  FORMAT(A)
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     GT_ORIENT        **
C**************************
C
C
      SUBROUTINE GT_ORIENT (STR, CLL, NCLL, ISYST, LATT, IROT, IBEAM,
     +                      IERR)
C
C      INCLUDE 'implicit_none.finc'
C
C Purpose: 
C
C Author:  John W. Campbell, May 1991
C
C Arguments:
C
      CHARACTER*(*) STR
      REAL CLL(6)
      INTEGER NCLL
      INTEGER ISYST
      INTEGER LATT
      INTEGER IROT
      INTEGER IBEAM
      INTEGER IERR
C      
C   STR       (R)   Character string containing the cell/setting details
C   CLL(6)    (W)   Returns the reciprocal cell parameters (compressed form)
C   NCLL      (W)   Returns the number of cell parameters
C   ISYST     (W)   Returns the crystal system 1=Triclinic ... 7=Cubic
C   LATT      (W)   Returns the lattice type 1-7
C   IROT      (W)   Returns the rotation axis -3 to 3
C   IBEAM     (W)   Returns the beam axis -3 to 3
C   IERR      (W)   Error flag =0 OK, =1 syntax error
C
C====== Parameter statements
C 

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

C
C====== LOCALS:
C
      INTEGER NC_VALS(7)
      INTEGER I
      INTEGER ISIGN
      INTEGER IAX(2)
      INTEGER NWORDS
      INTEGER NVALS
      REAL VALUES(10)
      CHARACTER*1 CHAR
      CHARACTER*15 WORDS(10)
      CHARACTER*12 SYST_STR(7)
      CHARACTER*2  LATT_STR(7)

C     INTEGER NC_VALS(7)                !No. of cell params for system types
C     INTEGER I                         !Temp/loop variable
C     INTEGER ISIGN                     !Sign for axis direction
C     INTEGER IAX(2)                    !Axis number
C     INTEGER NWORDS                    !Number of character items from STRTKN
C     INTEGER NVALS                     !Number of numeric items from STRTKN
C     REAL VALUES(10)                   !Numeric values from STRTKN
C     CHARACTER*1 CHAR                  !Temp character
C     CHARACTER*15 WORDS(10)            !Character strings from STRTKN
C     CHARACTER*12 SYST_STR(7)          !Options for crystal systems
C     CHARACTER*2 LATT_STR(7)           !Options for Lattice types

      DATA SYST_STR /'TRICLINIC',
     +               'MONOCLINIC',
     +               'ORTHORHOMBIC',
     +               'TETRAGONAL',
     +               'HEXAGONAL',
     +               'RHOMBOHEDRAL',
     +               'CUBIC'/
      DATA LATT_STR /'P ','A ','B ','C ','I ','F ','R '/
      DATA   NC_VALS  /6, 4, 3, 2, 2, 2, 1/
C
C-------------------------------------------------------------------------------
C
C
C====== Expect input to be of form:
C
C     <cell_parameters> <crystal_system> <lattice> <spindle_axis> <beam_axis>
C
C where:
C     <cell_parameters> are up to six numbers, and are in the order
C                       astar, bstar, cstar, alpha, beta, gamma
C                       Only supply as many as needed e.g. for rhombohedral
C                       just give   astar, alpha.
C
C     <crystal_system>  name of crystal system - only first three letters
C                       are used, e.g. tri for triclinic
C
C     <lattice>         a single letter for the type of unit cell. Default P
C
C     <beam_axis>       a word is needed here - only first two characters used
C                       i.e.  can start with  +a , +b , +c , -a , -b , -c
C                       specifies alignment of reciprocal lattice wrt.
C                       beam axis (i.e. X-axis)
C
C     <spindle_axis>    similar form to <beam_axis> but this time specifies
C                       alignment wrt. spindle axis (i.e. Z-axis)
C
C An e.g. of a complete input line is:
C
C     0.123 0.456 0.0789  ortho a +astar -cstar
C
C but could be shortened to
C
C     0.123 0.456 0.0789  ort a a -c
C
C Upper or lower case can be used and intermixed freely
C
C------------------------------------------------------------------------------
C
      IERR = 0
C
      CALL STRTKN(STR,' ,',10,WORDS,NWORDS,VALUES,NVALS)
      IF (NVALS.GT.6) NVALS = 6
      IF (NVALS.GT.0) THEN
         DO 20 I = 1 , NVALS
            CLL(I) = VALUES(I)
 20      CONTINUE
      END IF

      IF (NWORDS.LE.4) THEN
         IF (NWORDS.EQ.3) THEN
            WORDS(4) = WORDS(3)
            WORDS(3) = WORDS(2)
            WORDS(2) = 'P'
         END IF

         CALL CCPUPC(WORDS(1))
         CALL CCPUPC(WORDS(2))
         CALL CCPUPC(WORDS(3))
         CALL CCPUPC(WORDS(4))

         DO 30 I = 1 , 7
            IF (WORDS(1)(1:3).EQ.SYST_STR(I)(1:3)) GO TO 40
 30      CONTINUE
      END IF
      GO TO 60

 40   ISYST = I
      IF (NVALS.EQ.NC_VALS(I)) THEN

         DO 50 I = 1 , 2
            IF (WORDS(I+2)(1:1).EQ.'-') THEN
               ISIGN = -1
               CHAR = WORDS(I+2)(2:2)
            ELSE IF (WORDS(I+2)(1:1).EQ.'+') THEN
               ISIGN = 1
               CHAR = WORDS(I+2)(2:2)
            ELSE
               ISIGN = 1
               CHAR = WORDS(I+2)(1:1)
            END IF
            IAX(I) = 0
            IF (CHAR.EQ.'A') IAX(I) = 1
            IF (CHAR.EQ.'B') IAX(I) = 2
            IF (CHAR.EQ.'C') IAX(I) = 3
            IAX(I) = IAX(I)*ISIGN
            IF (IAX(I).EQ.0) GO TO 60
 50      CONTINUE
         IROT = IAX(1)
         IBEAM = IAX(2)

         IF (WORDS(2).EQ.'R' .AND. ISYST.NE.5) WORDS(2) = 'P'
         IF (WORDS(2).EQ.'P') THEN
            LATT = 1
         ELSE IF (WORDS(2).EQ.'A') THEN
            LATT = 2
         ELSE IF (WORDS(2).EQ.'B') THEN
            LATT = 3
         ELSE IF (WORDS(2).EQ.'C') THEN
            LATT = 4
         ELSE IF (WORDS(2).EQ.'I') THEN
            LATT = 5
         ELSE IF (WORDS(2).EQ.'F') THEN
            LATT = 6
         ELSE IF (WORDS(2).EQ.'R') THEN
            LATT = 7
         ELSE
            GO TO 60
         END IF
         RETURN
      END IF
C
C====== Error condition detected
C
 60   IERR = 1
      RETURN
      END
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***********************
C**     INTFP         **
C***********************
C
C
       FUNCTION INTFP (CHSTR, FP, IV) 
C
C Purpose:    Decode a character string into a number (floating and integer)
C
C Author:     John W. Campbell
C
C RETURN:     = 0  Syntax error in the number
C             = 1  integer  (no decimal point present)
C             = 2  floating point (decimal point present or E format)
C             = -1 blank string
C                                             
C Arguments:
C
C      CHSTR    (R)     Character string containing the number to be decoded
C                       (Leading spaces ignored; further space terminates
C                        the number string interpreted)
C      FP       (W)     Returns the value as a floating point value (0.0 if
C                       synatx error)
C      IV       (W)     Returns the value as an integer (the nearest integer
C                       if value contained a decimal point) (0 if syntax error)
C
C
C Declarations
C ============
C
C LOCALS:
C
      CHARACTER*(*) CHSTR
      CHARACTER*15 DIG
      LOGICAL END, START
      DOUBLE PRECISION FPVAL, X, S
      DATA DIG /'eE0123456789.+-'/
C
C-------------------------------------------------------------------------------
C
C
C====== Initialisations
C
      FPVAL = 0.0
      FP = 0.0
      IV = 0
      END = .FALSE.
      START = .FALSE.
      IEXP = 0
      M1 = 3
      M2 = 15
      I = 0
      IMAX = LEN (CHSTR) 
      IF (CHSTR.EQ.' ') THEN
         INTFP = -1
         RETURN
      ENDIF
C
C====== Interpret Number
C
100   S = 1.0
      ID = 0
      IFDEC = 0
      X = 0.0
120   I = I + 1
      IF (I.GT.IMAX) THEN
         END = .TRUE.
         IF (IEXP.EQ.1) GO TO 600
         GO TO 500
      ENDIF
      IF (CHSTR(I:I).EQ.' ') THEN
         IF (START) I = IMAX
         GO TO 120
      ENDIF
      J = INDEX(DIG(M1:M2),CHSTR(I:I))
      IF (J.EQ.0) GO TO 800
      START = .TRUE.
      J = J + M1 - 1
      M1 = 1 + 2*IEXP
C
C====== Digit
C
      IF (J.GE.3.AND.J.LE.12) THEN
         ID = ID + IFDEC
         X = 10.0 * X + J - 3
         IF (M2.GT.13) M2 = 13
         GO TO 120
C
C====== Decimal point
C
      ELSE IF (J.EQ.13) THEN
         IF (IEXP.EQ.1) GO TO 800
         IFDEC = 1
         M2 = 12
         GO TO 120
C
C====== Sign
C
      ELSE IF (J.GE.14) THEN
         IF (J.EQ.15) S = -1.0
         M2 = 13
         GO TO 120
C
C====== Exponent
C
      ELSE
         IEXP = 1
         M1 = 3
         M2 = 15
      ENDIF
C
C====== Evaluate number
C
500   FPVAL = S * X / (10**ID)
      IF (END) THEN
         FP = FPVAL
         IV = NINT (FP)
         INTFP = 1
         IF (IFDEC.GT.0) INTFP = 2
         RETURN
      ENDIF
      GO TO 100
C
C====== Evaluate and apply exponent
C
600   IEX = NINT (S*X)
      FPVAL = FPVAL * 10.0**IEX
      FP = FPVAL
      IV = NINT (FP)
      INTFP = 2
      RETURN
C
C====== Error Condition
C
800   INTFP = 0
      RETURN
      END
