**==aa0001.f  
C
C PROGRAM 'LAUELAM'
C =================
C
C READ A LAUE DATA FILE AND CREATE FROM IT AN MTZ FILE IN A
C SUITABLE FORM FOR ROTAVATA/AGROVATA IN WHICH THE DATA ARE
C SPLIT INTO BATCHES BY WAVELENGTH.
C
C PARAMETER STATEMENTS
C
C          MXL = MAXIMUM NUMBER OF LAUE RANGES
C          MXB = MAXIMUM NUMBER OF BATCHES ALLOWED
C          MXR = MAXIMUM NUMBER OF REFLECTIONS FOR OVERLAP ANALYSIS
C
      PARAMETER(MXL=3,MXB=100,MXR=50000)
C
C
C SPECIFICATION STATEMENTS
C ------------------------
C
      LOGICAL BAT(MXB),END
      DIMENSION NREFB(MXB),YMIN(MXB),YMAX(MXB),IOVLAP(MXB,MXB)
      DIMENSION BMINL(MXL),BMAXL(MXL),BINS(MXL),NP(MXL),NBIN(MXL)
      DIMENSION IA(2*MXR)
      REAL RSYMM(4,4,96)
      CHARACTER*10 PGNAME
      CHARACTER*72 TITL,ITEXT,BTITL
      CHARACTER*30 LABLS(7)
      CHARACTER*1 CTYPS(7)
      CHARACTER*10 SPGNAM
      CHARACTER*10 PGN
      CHARACTER*80 HSTR(2)
      DIMENSION CELL(6),IDATA(8),ADATA(8)
      COMMON /SYMM1/PGNAME
      DATA BTITL/'WAVELENGTH BATCH        TO'/
      DATA LABLS/'H','K','L','M/ISYM','BATCH','I','SIGI'/
      DATA CTYPS/'H','H','H','Y','B','J','Q'/
      DATA BAT/100*.FALSE./,NREFB/100*0/
      DATA NTWO16/65536/
      DATA NTWO8/256/
      DATA HSTR/'File created by LAUELAM program',' '/
C
C INITIALISATIONS
C ---------------
C
      ALMIN = 100000.0
      ALMAX = 0.0
      ADATA(8) = 0.0
      NOV = 0
      NRIN = 0
      NROUT = 0
      NREJ = 0
      NREJL = 0
      IFAIL = 0
      CALL CCPOPN(5,'DATA',5,1,LDUM,IFAIL)
      CALL CCPOPN(6,'PRINTER',6,1,LDUM,IFAIL)
      CALL CCPVRS(6,'LAUELAM','15/10/92')
      CALL CCPOPN(1,'LAUE1',5,1,LDUM,IFAIL)
      CALL MTZINI
C
C READ DATA CONTROL CARDS AND OPEN OUTPUT MTZ FILE
C ------------------------------------------------
C
C DATA CARD 1   TITLE FOR OUTPUT FILE
C
      READ (5,6010) TITL
C
C DATA CARD 2   CELL DIMENSIONS
C
      CALL FFREAD(5,ITEXT,72,6,.TRUE.)
      DO 20 I = 1 , 6
         CALL FVALUE(CELL(I))
 20   CONTINUE
C
C DATA CARD 3   SPACE GROUP NUMBER, NO. RANGES, SERIAL NO., INPUT SCALE
C
      CALL FFREAD(5,ITEXT,72,6,.TRUE.)
      CALL IVALUE(NSPGRP)
      IF (NSPGRP.LE.0) NSPGRP = 1
      CALL IVALUE(NRANGE)
      IF (NRANGE.LE.0) NRANGE = 1
      IF (NRANGE.GT.MXL) THEN
         WRITE (6,6220)
         STOP
      ELSE
         CALL IVALUE(ISER)
         IF (ISER.LE.0) ISER = 1001
         CALL FVALUE(SCALIN)
         IF (SCALIN.LE.0.0) SCALIN = 1.0
         WRITE (6,6030) NSPGRP , NRANGE , ISER , SCALIN
C
C DATA CARDS 4  BMINL BMAXL BINS
C
C  * NRANGE
C
         DO 30 NN = 1 , NRANGE
            CALL FFREAD(5,ITEXT,72,6,.TRUE.)
            CALL FVALUE(BMINL(NN))
            CALL FVALUE(BMAXL(NN))
            CALL FVALUE(BINS(NN))
            WRITE (6,6070) NN
            WRITE (6,6080) BMINL(NN) , BMAXL(NN)
            WRITE (6,6090) BINS(NN)
 30      CONTINUE
         IF (NRANGE.EQ.1 .AND. BMINL(1).EQ.0.0 .AND. BMAXL(1).EQ.0.0)
     +          THEN
            WRITE (6,6150)
            GO TO 50
         END IF
         DO 40 NN = 1 , NRANGE
            IF (BMINL(NN).LT.0.0) GO TO 230
            IF (BMAXL(NN).LT.0.0) GO TO 230
            IF (BMAXL(NN).LE.BMINL(NN)) GO TO 230
            IF (NN.NE.NRANGE) THEN
               IF (BMAXL(NN).GE.BMINL(NN+1)) GO TO 230
            END IF
 40      CONTINUE
      END IF
C
C GET SYMMETRY
C ------------
C
      CALL MSYMLB (10,NSPGRP,SPGNAM,PGN,NSYMP,NSYMM,RSYMM)
C
C OPEN MTZ FILE
C -------------
C
      CALL LWOPEN (1,'HKLOUT')
      CALL LWTITL (1,TITL(1:70),0)
      CALL LWHIST (1,HSTR,1)
      CALL LWCELL (1,CELL)
      CALL LWCLAB (1,LABLS,7,CTYPS,0)
      CALL LWSYMM (1,NSYMM,NSYMP,RSYMM,SPGNAM(1:1),NSPGRP,SPGNAM,
     +             PGN)
      PGNAME = PGN(3:)
      CALL SYMMAT
C
C FIND MINIMUM AND MAXIMUM LAMBDA VALUES IN INPUT FILE
C ----------------------------------------------------
C
 50   READ (1,6020,END=60) IH , IK , IL , ALBDA
      NRIN = NRIN + 1
      ALMAX = AMAX1(ALMAX,ALBDA)
      ALMIN = AMIN1(ALMIN,ALBDA)
      GO TO 50
C
C CALCULATE BIN REQUIREMENTS
C
 60   NBTOT = 0
      IF (NRANGE.EQ.1 .AND. BMINL(1).EQ.0.0 .AND. BMAXL(1).EQ.0.0) THEN
         BMINL(1) = ALMIN
         BMAXL(1) = ALMAX
      END IF
      DO 70 NN = 1 , NRANGE
         IF (BINS(NN).LE.0.0) GO TO 250
         IF (BINS(NN).GT.1.0) NBIN(NN) = NINT(BINS(NN))
         IF (BINS(NN).LE.1.0) NBIN(NN) = (BMAXL(NN)-BMINL(NN))/BINS(NN)
     +       + 0.999
         NBTOT = NBTOT + NBIN(NN)
         IF (NBTOT.GT.MXB) GO TO 240
         WRITE (6,6100) NBIN(NN) , NN
 70   CONTINUE
      NPP = 0
      DO 80 NN = 1 , NRANGE
         NP(NN) = NPP
         NPP = NPP + NBIN(NN)
 80   CONTINUE
      WRITE (6,6040) NRIN
      WRITE (6,6050) ALMIN , ALMAX , NBTOT
      IF (NBTOT.GT.MXB) GO TO 240
      REWIND 1
C
C RE-READ LAUE DATA AND WRITE OUTPUT FILE
C ---------------------------------------
C
 90   READ (1,6020,END=140) IH , IK , IL , ALBDA , THETA , II , ISIG
      IF (PGNAME(1:1).EQ.'3' .OR. PGNAME(1:1).EQ.'6' .OR. PGNAME(1:1)
     +    .EQ.'4') THEN
         CALL TURN3(IH,IK,IL,KSYM)
      ELSE
         CALL TURNIP(IH,IK,IL,KSYM)
      END IF
      ADATA(1) = IH
      ADATA(2) = IK
      ADATA(3) = IL
      ADATA(4) = KSYM
      DO 100 NN = 1 , NRANGE
         IF (ALBDA.GE.BMINL(NN) .AND. ALBDA.LE.BMAXL(NN)) GO TO 110
 100  CONTINUE
      NREJL = NREJL + 1
      GO TO 90
 110  IB = NBIN(NN)*(ALBDA-BMINL(NN))/(BMAXL(NN)-BMINL(NN)) + 1
      IF (IB.LT.1) IB = 1
      IF (IB.GT.NBIN(NN)) IB = NBIN(NN)
      NB = IB
      IB = IB + NP(NN)
      IF (.NOT.BAT(IB)) THEN
         IBATCH = ISER - 1 + IB
         YMIN(IB) = (NB-1)*(BMAXL(NN)-BMINL(NN))/NBIN(NN) + BMINL(NN)
         YMAX(IB) = NB*(BMAXL(NN)-BMINL(NN))/NBIN(NN) + BMINL(NN)
         IF (YMAX(IB).GT.BMAXL(NN)) YMAX(IB) = BMAXL(NN)
         WRITE (BTITL(18:23),6060) YMIN(IB)
         WRITE (BTITL(28:33),6060) YMAX(IB)
         CALL LWBTIT (1,IBATCH,BTITL)
         BAT(IB) = .TRUE.
      END IF
      ADATA(5) = 1000 + IB
      ADATA(6) = SCALIN*II
      ADATA(7) = SCALIN*ISIG
      CALL LWREFL (1,ADATA)
      NOV = NOV + 1
      IF (NOV.LE.MXR) THEN
         IF (IH.LT.-127 .OR. IH.GT.128) THEN
            NOV = NOV - 1
            GO TO 120
         END IF
         IF (IK.LT.-127 .OR. IK.GT.127) THEN
            NOV = NOV - 1
            GO TO 120
         END IF
         IF (IL.LT.-127 .OR. IL.GT.127) THEN
            NOV = NOV - 1
            GO TO 120
         END IF
         JJ = 2*NOV - 1
         IA(JJ) = NTWO16*(IH+128) + NTWO8*(IK+128) + IL + 128
         IA(JJ+1) = IB
      END IF
 120  NROUT = NROUT + 1
      NREFB(IB) = NREFB(IB) + 1
      GO TO 90
C
C END OF FILE REACHED
C -------------------
C
 140  WRITE (6,6110) NROUT , NREJL
      CALL LWCLOS (1,1)
C
C PRINT BATCH SUMMARY
C ------------------
C
      WRITE (6,6120) NBTOT
      DO 150 N = 1 , NBTOT
         IBATCH = ISER - 1 + N
         IF (BAT(N)) THEN
            WRITE (6,6130) IBATCH , NREFB(N) , YMIN(N) , YMAX(N)
         ELSE
            WRITE (6,6140) IBATCH , NREFB(N)
         END IF
 150  CONTINUE
C
C FIND OVERLAPS
C =============
C
      IF (NOV.EQ.0) STOP
      IF (NOV.GT.MXR) THEN
         WRITE (6,6160) MXR
         STOP
      END IF
      CALL REFSRT(IA,NOV,2,2*NOV)
      DO 170 I = 1 , NBTOT
         DO 160 J = 1 , NBTOT
            IOVLAP(I,J) = 0
 160     CONTINUE
 170  CONTINUE
      END = .FALSE.
      M1 = 1
      ILAST = IA(1)
      K = 0
 180  K = K + 1
      IF (K.GT.NOV) THEN
         END = .TRUE.
         GO TO 190
      END IF
      JJ = 2*K - 1
      IF (IA(JJ).EQ.ILAST) GO TO 180
 190  M2 = K - 1
      IF (M2.GT.M1) THEN
         DO 210 M = M1 , M2
            I1 = IA(2*M)
            MM1 = M + 1
            IF (MM1.LE.M2) THEN
               DO 200 MM = MM1 , M2
                  I2 = IA(2*MM)
                  IOVLAP(I1,I2) = IOVLAP(I1,I2) + 1
                  IF (I1.NE.I2) IOVLAP(I2,I1) = IOVLAP(I1,I2)
 200           CONTINUE
            END IF
 210     CONTINUE
      END IF
      IF (END) THEN
C
C PRINT OVERLAPS TABLE
C --------------------
C
         WRITE (6,6170)
         WRITE (6,6180) (ISER+I-1,I=1,NBTOT)
         DO 220 N = 1 , NBTOT
            WRITE (6,6190) ISER + N - 1 , (IOVLAP(N,K),K=1,NBTOT)
 220     CONTINUE
         STOP
      ELSE
         M1 = K
         ILAST = IA(JJ)
         GO TO 180
      END IF
 230  WRITE (6,6230) (BMINL(NN),BMAXL(NN),NN=1,NRANGE)
      STOP
 240  WRITE (6,6240) MXB
      STOP
 250  WRITE (6,6250) BINS(NN) , NN
      STOP
C
C FORMAT STATEMENTS
C -----------------
C
 6010 FORMAT (A)
 6020 FORMAT (3I5,2F10.5,2I10)
 6030 FORMAT (/,' SPACE GROUP NUMBER =',I4,//,
     +        ' NUMBER OF LAMBDA RANGES = ',I1,//,
     +        ' SERIAL NUMBER OF FIRST BATCH =',I6,//,
     +        ' SCALE FACTOR APPLIED TO INPUT LAUE DATA =',F6.3)
 6040 FORMAT (//,' NUMBER OF REFLECTIONS READ FROM INPUT LAUE FILE =',
     +        I6)
 6050 FORMAT (//,' FROM INPUT LAUE FILE LAMBDA RANGE =',F6.3,' TO',F6.3,
     +        //,' NUMBER OF BATCHES =',I4)
 6060 FORMAT (F6.3)
 6070 FORMAT (////,' WAVELENGTH RANGE',I2)
 6080 FORMAT (//,' MINIMUM LAMBDA =',F5.3,'A  MAXIMUM LAMBDA =',F5.3,
     +        'A')
 6090 FORMAT (//,' BINS PARAMETER =',F7.3)
 6100 FORMAT (//,' NUMBER OF LAMBDA BINS TO BE USED FOR NORMALISATION ='
     +        ,I4,' FOR RANGE',I2,/)
 6110 FORMAT (//,' NUMBER OF REFLECTIONS WRITTEN TO OUTPUT FILE  =',I6,
     +       /, ' NUMBER REJECTED (OUTSIDE OF LAMBDA RANGES)    =',I6)
 6120 FORMAT (//,' TOTAL NUMBER OF POSSIBLE BATCHES OUTPUT =',I4,//,
     +        ' SUMMARY OF OUTPUT BATCH DATA:',//,
     +        ' IBATCH  NO.REFLNS  BATCH TITLE',/)
 6130 FORMAT (' ',I6,I11,'  WAVELENGTH BATCH',F7.3,' TO',F7.3)
 6140 FORMAT (' ',I6,I11,'  **BATCH OMITTED**')
 6150 FORMAT (//,' LAMBDA LIMITS WILL BE TAKEN FROM INPUT LAUE FILE')
 6160 FORMAT (///,' OVERLAP ANALYSIS NOT CARRIED OUT BECAUSE THERE',
     +        ' ARE MORE THAN',I6,' REFLECTIONS PRESENT')
 6170 FORMAT (///,' OVERLAP ANALYSIS',//)
 6180 FORMAT (10X,20I6)
 6190 FORMAT (/,' ',I5,4X,20I6,(/,10X,20I6))
C
 6200 FORMAT (/,' **POINT GROUP NAME MUST BE GIVEN**')
 6210 FORMAT (/,' **POINT GROUP NAME MUST HAVE MAX. OF 4 CHARACTERS**')
 6220 FORMAT (/,' **MAXIMUM OF ',I2,' RANGES ALLOWED**')
 6230 FORMAT (/,' **LAMBDA RANGE LIMITS MUST BE IN INCREASING POSITIVE',
     +        ' VALUES OF LAMBDA**:',12F7.3)
 6240 FORMAT (/,' **MAX OF ',I3,' BINS ALLOWED**')
 6250 FORMAT (/,' **BINS PARAMETER MUST BE GREATER THAN 0, BINS =',
     +        F10.5,' FOR RANGE',I2,' **')
      END
**==refsrt.f  
C
C SUBROUTINE 'REFSRT'
C ===================
C
C THIS SUBROUTINE IS USED TO SORT THE REFLECTION DATA HELD IN CORE. IT
C IS A MODIFIED VERSION OF THE SUBROUTINE 'AHVSOR' FROM ELEANOR DODSON'S
C VERSION OF THE PROGRAM 'CAD'. THIS VERSION SORTS ON A WORD CONTAINING
C THE PACKED INDICES.
C
      SUBROUTINE REFSRT(IA,NREF,NWRD,IDIM)
C
C PARAMETERS
C
C         IA (I/O)  INTEGER ARRAY CONTAINING THE REFLECTION DATA WITH
C                   NWRD WORDS FOR REFLN 1 FOLLOWED BY NWRD WORDS FOR
C                   EACH REFLECTION UP TO NREF REFLECTIONS  (NWRD <=10)
C       NREF (I)    THE NO. OF REFLECTIONS TO BE SORTED
C       NWRD (I)    NUMBER OF WORDS/REFLECTION (INDICES PACKED IN FIRST
C                   WORD FOR EACH REFLECTION)
C       IDIM (I)    THE NUMBER OF ELEMENTS IN THE ARRAY IA
C
C SPECIFICATION STATEMENTS
C ------------------------
C
      IMPLICIT INTEGER(A-Z)
      INTEGER IA(IDIM),ITEMP,CUT(10)
      INTEGER SAVE(2,16)
      DATA CUTOFF/20/
C
C SORT DATA
C ---------
C
      STACK = 0
      LOW = 1
      HIGH = NREF
 20   CHUNK = HIGH - LOW
      IF (CHUNK.GT.CUTOFF) THEN
         MIDDLE = (LOW+HIGH)/2
         IF (ICMP(IA,LOW,IA,MIDDLE).GT.0) THEN
            J1 = NWRD*(LOW-1)
            J2 = NWRD*(MIDDLE-1)
            DO 30 I = 1 , NWRD
               J1 = J1 + 1
               J2 = J2 + 1
               ITEMP = IA(J1)
               IA(J1) = IA(J2)
               IA(J2) = ITEMP
 30         CONTINUE
         END IF
         IF (ICMP(IA,MIDDLE,IA,HIGH).GT.0) THEN
            J1 = NWRD*(MIDDLE-1)
            J2 = NWRD*(HIGH-1)
            DO 40 I = 1 , NWRD
               J1 = J1 + 1
               J2 = J2 + 1
               ITEMP = IA(J1)
               IA(J1) = IA(J2)
               IA(J2) = ITEMP
 40         CONTINUE
            IF (ICMP(IA,LOW,IA,MIDDLE).GT.0) THEN
               J1 = NWRD*(LOW-1)
               J2 = NWRD*(MIDDLE-1)
               DO 50 I = 1 , NWRD
                  J1 = J1 + 1
                  J2 = J2 + 1
                  ITEMP = IA(J1)
                  IA(J1) = IA(J2)
                  IA(J2) = ITEMP
 50            CONTINUE
            END IF
         END IF
         J = NWRD*(MIDDLE-1)
         DO 60 I = 1 , NWRD
            J = J + 1
            CUT(I) = IA(J)
 60      CONTINUE
         UP = LOW
         DOWN = HIGH
 70      DOWN = DOWN - 1
         IF (ICMP(CUT,1,IA,DOWN).LT.0) GO TO 70
 80      UP = UP + 1
         IF (ICMP(CUT,1,IA,UP).GT.0) GO TO 80
         IF (UP.LT.DOWN) THEN
            J1 = NWRD*(UP-1)
            J2 = NWRD*(DOWN-1)
            DO 90 I = 1 , NWRD
               J1 = J1 + 1
               J2 = J2 + 1
               ITEMP = IA(J1)
               IA(J1) = IA(J2)
               IA(J2) = ITEMP
 90         CONTINUE
            GO TO 70
         ELSE IF (UP.EQ.DOWN) THEN
            DOWN = DOWN - 1
            UP = UP + 1
         END IF
      ELSE
         IF (CHUNK.GE.2) THEN
            MM = HIGH - 1
            DO 120 M = LOW , MM
               MIN = M
               MMM = M + 1
               DO 100 N = MMM , HIGH
                  IF (ICMP(IA,MIN,IA,N).GT.0) THEN
                     MIN = N
                  END IF
 100           CONTINUE
               IF (MIN.NE.M) THEN
                  J1 = NWRD*(M-1)
                  J2 = NWRD*(MIN-1)
                  DO 110 I = 1 , NWRD
                     J1 = J1 + 1
                     J2 = J2 + 1
                     ITEMP = IA(J1)
                     IA(J1) = IA(J2)
                     IA(J2) = ITEMP
 110              CONTINUE
               END IF
 120        CONTINUE
         END IF
         IF (STACK.EQ.0) RETURN
         LOW = SAVE(1,STACK)
         HIGH = SAVE(2,STACK)
         STACK = STACK - 1
         GO TO 20
      END IF
      STACK = STACK + 1
      IF (STACK.GT.16) THEN
C
C ERROR CONDITION
C ----------------
C
         WRITE (6,6010) STACK
         STOP
      ELSE
         BOTTOM = DOWN - LOW
         TOP = HIGH - UP
         IF (BOTTOM.GT.TOP) THEN
            SAVE(1,STACK) = LOW
            SAVE(2,STACK) = DOWN
            LOW = UP
         ELSE
            SAVE(1,STACK) = UP
            SAVE(2,STACK) = HIGH
            HIGH = DOWN
         END IF
         GO TO 20
      END IF
C
C FORMAT STATEMENTS
C -----------------
C
 6010 FORMAT (' **STACK LIMIT OF 16 EXCEEDED IN REFSOR**')
      END
**==icmp.f  
C
C FUNCTION 'ICMP'
C ===============
C
C THIS FUNCTION IS USED TO COMPARE THE VALUES OF THE SORT KEYS
C FOR 2 REFLECTIONS  (ASSUMES 2 WORDS/REFLECTION)
C
      FUNCTION ICMP(IARR1,I1,IARR2,I2)
C
C PARAMETERS
C
C        IARR1 (I)   ARRAY CONTAINING 1ST REFLN
C           I1 (I)   POINTER TO REFLECTION IN IARR1
C        IARR2 (I)   ARRAY CONTAINING 2ND REFLN
C           I2 (I)   POINTER TO REFLECTIONIIN IARR2
C
C FUNCTION RETURN VALUES  -1  REFLN 1 LT REFLN 2
C                          0  REFLN 1 EQ REFLN 2
C                          1  REFLN 1 GT REFLN 2
C
C SPECIFICATION STATEMENTS
C ------------------------
C
      INTEGER IARR1(*),IARR2(*)
C
C COMPARE KEYS
C ------------
C
      J1 = 2*I1 - 1
      J2 = 2*I2 - 1
      IF (IARR1(J1).LT.IARR2(J2)) THEN
         ICMP = -1
         RETURN
      ELSE IF (IARR1(J1).EQ.IARR2(J2)) THEN
         ICMP = 0
         RETURN
      ELSE
         ICMP = 1
         RETURN
      END IF
      END
**==ffread.f  
C
C
C SUBROUTINE 'FFREAD'  ENTRIES: 'IVALUE' 'FVALUE' 'TEXLIM'
C ========================================================
C
C THIS SUBROUTINE ENABLES FREE FORMAT INPUT OF DATA. IT IS CALLED
C ONCE TO READ IN THE TEXT BUFFER  AND CALLED VIA AN ENTRY POINT
C FOR EACH INTEGER, FLOATING POINT OR TEXT FIELD IN TURN.
C
      SUBROUTINE FFREAD(IUN,LTEXT,LMAX,LLP,LSTOP)
C
C PARAMETERS
C
C       IUN (I)   UNIT NUMBER FOR READ (MAY BE SET TO ZERO IF THE TEXT
C                 TO BE INTERPRETED IS ALREADY IN THE ARRAY 'ITEXT')
C     LTEXT (I/O) CHARACTER ARRAY FOR TEXT BUFFER
C      LMAX (I)   THE MAXIMUM NO. OF CHARS IN 'ITEXT' (UP TO 150)
C       LLP (I)   UNIT NUMBER FOR ERROR MESSAGES (0 IF NONE REQUIRED)
C     LSTOP (I)   LOGICAL FLAG =TRUE, STOP IF ERROR, =FALSE CONTINUE.
C
C ENTRY IVALUE(IVAL)       RETURN INTEGER VALUE 'IVAL' FROM NEXT FIELD
C -----------------
C
C ENTRY FVALUE(FVAL)       RETURN F.P. VALUE 'FVAL' FROM NEXT FIELD
C -----------------
C
C ENTRY TEXLIM(MIN,MAX)    RETURN NOS. OF FIRST AND FINAL CHARACTERS IN
C ---------------------    FIELD IN 'MIN' AND 'MAX'
C
C NOTE: ENTRY PARAMETER VALUES ARE RETURNED AS ZERO FOR BLANK FIELDS
C       OR IF CONTINUING AFTER A SYNTAX ERROR.
C
C
C SPECIFICATION STATEMENTS
C
      CHARACTER*1 ITEXT
      CHARACTER*1 ISP,IPLUS,IMINUS,IDEC,ICOMMA
      CHARACTER*1 LTEXT(*),INUM(10)
      LOGICAL LSTOP,ISTOP,ERR
      COMMON /FFRDXX/ITEXT(150)
      COMMON /FFRDYY/NMAX,ILP,ISTOP,IFLD,M
      SAVE /FFRDXX/,/FFRDYY/
      DATA ISP/' '/,IPLUS/'+'/,IMINUS/'-'/,IDEC/'.'/,ICOMMA/','/
      DATA INUM/'0','1','2','3','4','5','6','7','8','9'/
C
C SAVE VARIABLES FOR ENTRY POINTS
C
      NMAX = LMAX
      IF (LMAX.GT.150) THEN
         IF (ILP.GT.0) WRITE (ILP,6030)
         STOP 810
      ELSE
         ILP = LLP
         ISTOP = LSTOP
C
C INITIAL ENTRY
C
         M = 0
         IFLD = 0
         IF (IUN.GT.0) READ (IUN,6010) (LTEXT(N),N=1,NMAX)
         DO 20 I = 1 , LMAX
            ITEXT(I) = LTEXT(I)
 20      CONTINUE
         RETURN
      END IF
C
C ENTRIES FOR INTEGER AND FLOATING POINT VALUES
C
      ENTRY IVALUE(IVAL)
C     ==================
C
      ITYP = 0
      IVAL = 0
      GO TO 30
      ENTRY FVALUE(FVAL)
C     ==================
C
      ITYP = 1
      FVAL = 0.0
 30   S = 1.0
      X = 0.0
      ERR = .FALSE.
      IFDEC = 0
      ID = 0
      IFLD = IFLD + 1
 40   M = M + 1
      IF (M.GT.NMAX) GO TO 100
      IF (ITEXT(M).EQ.ISP) GO TO 40
      IF (ITEXT(M).EQ.ICOMMA) GO TO 40
      IF (ITEXT(M).NE.IPLUS) THEN
         IF (ITEXT(M).NE.IMINUS) GO TO 60
         S = -1.0
      END IF
 50   M = M + 1
      IF (M.GT.NMAX) GO TO 90
      IF (ITEXT(M).EQ.ISP) GO TO 90
      IF (ITEXT(M).EQ.ICOMMA) GO TO 90
 60   IF (ITEXT(M).NE.IDEC) THEN
         DO 70 I = 1 , 10
            N = I - 1
            IF (ITEXT(M).EQ.INUM(I)) GO TO 80
 70      CONTINUE
         ERR = .TRUE.
      ELSE
         IF (IFDEC.EQ.1) ERR = .TRUE.
         IFDEC = 1
      END IF
      GO TO 50
 80   ID = ID + IFDEC
      X = 10.0*X + N
      GO TO 50
 90   X = S*X/(10.0**ID)
      IF (ERR) GO TO 130
 100  IF (ITYP.NE.0) THEN
         FVAL = X
         RETURN
      ELSE
         IF (IFDEC.NE.0) GO TO 130
         IVAL = X + 0.1*S
         RETURN
      END IF
C
C TEXT STRINGS ENTRY
C
      ENTRY TEXLIM(MIN,MAX)
C     =====================
C
      MIN = 0
      MAX = 0
      IFLD = IFLD + 1
 110  M = M + 1
      IF (M.GT.NMAX) RETURN
      IF (ITEXT(M).EQ.ISP) GO TO 110
      MIN = M
 120  MAX = M
      M = M + 1
      IF (M.GT.NMAX) RETURN
      IF (ITEXT(M).NE.ISP) GO TO 120
      RETURN
C
C ERROR FOUND
C
 130  IF (ILP.GT.0) WRITE (ILP,6020) IFLD , (ITEXT(I),I=1,NMAX)
      IF (ISTOP) STOP
      RETURN
C
C FORMAT STATEMENTS
C
 6010 FORMAT (255A1)
 6020 FORMAT (' **SYNTAX ERROR IN FIELD',I3,' **'/(1X,130A1/))
 6030 FORMAT (' **MAXIMUM LENGTH OF TEXT ALLOWED IN FFREAD IS 150',
     +        ' CHARACTERS**')
      END
