PROGRAM ALADDIN
C                         *****************
C                         * A L A D D I N *
C                         *****************
C
C                      VERSION 1.0    30/04/1989
C
C                  ALADDIN INTERACTIVE DATABASE PROGRAM
C
C     INTERACTIVE ACCESS TO ALADDIN DATABASE FILES; SEARCH FOR, DISPLAY,
C     EVALUATE, AND WRITE OUT ENTRY DATA.
C
C     ORIGINAL VERSION DESIGNED AND WRITTEN BY R. A. HULSE, OF THE
C     PRINCETON UNIVERSITY, PLASMA PHYSICS LABORATORY.
C     [REFERENCE: "THE ALADDIN ATOMIC PHYSICS DATABASE SYSTEM,"
C      PP. 68-72 IN 'ATOMIC PROCESSES IN PLASMAS,' AIP CONFERENCE
C      PROCEEDINGS 206, EDS. Y.K. KIM AND R.C. ELTON, AMERICAN INSTITUTE
C      OF PHYSICS, NEW YORK (1990)].
C---------------------------------------------------------------------- --------
C
C     REV: 2/07/89 BY J. J. SMITH IAEA ATOMIC AND MOLECULAR DATA UNIT
C       1.  THE PRECISION OF THE NUMERIC COEFFICIENT DATA, IN ARRAY CF,
C           CHANGED FROM SINGLE TO DOUBLE PRECISION.
C       2.  MAXIMUM LABEL LENGTH CHANGED FROM 20 TO 40 CHARACTERS.
C       3.  THE DISPLAY OF LABELS HAS BEEN MODIFIED TO PRINT LABELS
C           WITHIN BOXES OF LENGTH DETERMINED BY THE LABEL LENGTH.
C           (ROUTINE ALLCON ADDED TO CONCATENATE AND PRINT LABELS).
C       4.  DISPLAY OF COEFFICIENTS HAS BEEN MODIFIED TO DISPLAY
C           COEFFICIENTS WITH TRAILING (RIGHTMOST) ZEROS REMOVED.
C
C-------------------------------------------------------------------------------
C
      INCLUDE 'ALPCOM.FOR'
C
      INCLUDE 'ALCOM.FOR'
C
C-------------------------------------------------------------------------------
C
      LOGICAL ALCIEQ
      EXTERNAL ALCIEQ
C
C-------------------------------------------------------------------------------
C
C     INITIALIZE
C
      LUTIN = 5
      LUTOUT = 6
      LUDF = 20
      DFNAME = '**NONE**'
      LUOF = 21
      OFNAME = '**NONE**'
      LUQF = 22
      QFNAME = '**NONE**'
      LUEF = 23
      EFNAME = '**NONE**'
C
      NHSL = 0
      NBASL = 0
      NBNSL = 0
C
C-------------------------------------------------------------------------------
C
C     PROMPT FOR INITIAL OPENING OF AN INPUT DATA FILE
C
   10 CALL ALF
      IF(.NOT.OK) GO TO 10
C
C     PROMPT FOR INITIAL OPENING OF A QUERY FILE
C
      CALL ALQF
C
C*******************************************************************************
C
C     COMMAND PROCESSING LOOP
C
  100 WRITE(LUTOUT, '(/''$ALADDIN>> '')' )
      READ(LUTIN, '(A)') CMND
C
C     USE IF...THEN SEQUENCE TO SELECT PROPER COMMAND SUBROUTINE TO CALL
C
      IF(INDEX(CMND,'?') .NE. 0) THEN
        CALL ALQMRK
C
      ELSE IF(ALCIEQ(CMND(1:2),'SL')
     &        .OR. ALCIEQ(CMND(1:1), 'L')) THEN
        CALL ALL
C
      ELSE IF(ALCIEQ(CMND(1:1), 'S')) THEN
        CALL ALS
C
      ELSE IF(ALCIEQ(CMND(1:1), 'G')) THEN
        CALL ALG
C
      ELSE IF(ALCIEQ(CMND(1:1), 'N')) THEN
        CALL ALN
C
      ELSE IF(ALCIEQ(CMND(1:1), 'D')) THEN
        CALL ALD
C
      ELSE IF(ALCIEQ(CMND(1:2), 'EV')) THEN
        CALL ALEV
C
      ELSE IF(ALCIEQ(CMND(1:2), 'EF')) THEN
        CALL ALEF
C
      ELSE IF(ALCIEQ(CMND(1:1), 'R')) THEN
        CALL ALR
C
      ELSE IF(ALCIEQ(CMND(1:1), 'F')) THEN
        CALL ALF
C
      ELSE IF(ALCIEQ(CMND(1:2), 'OF')) THEN
        CALL ALOF
C
      ELSE IF(ALCIEQ(CMND(1:2), 'WR')) THEN
        CALL ALWR
C
      ELSE IF(ALCIEQ(CMND(1:2), 'EN')
     &        .OR. ALCIEQ(CMND(1:2), 'EX')) THEN
        CALL ALEX
C
      ELSE IF(ALCIEQ(CMND(1:1), 'H')
     &        .OR. CMND .EQ. ' ') THEN
        CALL ALH
C
      ELSE IF(ALCIEQ(CMND(1:2), 'QF')) THEN
        CALL ALQF
C
      ELSE
        WRITE(LUTOUT,
     &  '(/'' UNKNOWN COMMAND (TYPE H FOR HELP)'')' )
C
      ENDIF
C
      GO TO 100
C
      END
C
C###############################################################################
C
      SUBROUTINE ALL
C
C     L = DEFINE SEARCH LABELS
C
      INCLUDE 'ALCOM.FOR'
C
      WRITE(LUTOUT,
     &      '(/'' USE " ." AFTER LAST SEARCH LABEL IS ENTERED''/)' )
      NHSL = 0
  100 WRITE(LUTOUT,
     & '('' HIERARCHICAL SEARCH LABELS (* AND ** ARE WILDCARDS) ?'')')
      READ(LUTIN, '(A)') CMND
C
      ILPTR = 1
      ICPTR = 1
  200 CALL ALXLBL(CMND, 1, ILPTR, ICPTR, LABEL, NCHLBL, IFLAG)
C
      IF(IFLAG .EQ. -1) THEN
        WRITE(LUTOUT, '('' LABEL "'', A, ''" TOO LONG'')' ) LABEL
        RETURN
      ENDIF
C
      IF(IFLAG .EQ. 1) GO TO 100
C
      IF(IFLAG .EQ. 0 .AND. LABEL .NE. '.') THEN
        NHSL = NHSL + 1
        HSL(NHSL) = LABEL
        GO TO 200
      ENDIF
C
      NBASL = 0
  300 WRITE(LUTOUT, '('' BOOLEAN .AND. SEARCH LABELS ?'')' )
      READ(LUTIN, '(A)') CMND
C
      ILPTR = 1
      ICPTR = 1
  400 CALL ALXLBL(CMND, 1, ILPTR, ICPTR, LABEL, NCHLBL, IFLAG)
C
      IF(IFLAG .EQ. -1) THEN
        WRITE(LUTOUT, '('' LABEL "'', A, ''" TOO LONG'')' ) LABEL
        RETURN
      ENDIF
C
      IF(IFLAG .EQ. 1) GO TO 300
C
      IF(IFLAG .EQ. 0 .AND. LABEL .NE. '.') THEN
        NBASL = NBASL + 1
        BASL(NBASL) = LABEL
        GO TO 400
      ENDIF
C
      NBNSL = 0
  500 WRITE(LUTOUT, '('' BOOLEAN .NOT. SEARCH LABELS ?'')' )
      READ(LUTIN, '(A)') CMND
C
      ILPTR = 1
      ICPTR = 1
  600 CALL ALXLBL(CMND, 1, ILPTR, ICPTR, LABEL, NCHLBL, IFLAG)
C
      IF(IFLAG .EQ. -1) THEN
        WRITE(LUTOUT, '('' LABEL "'', A, ''" TOO LONG'')' )
        RETURN
      ENDIF
C
      IF(IFLAG .EQ. 1) GO TO 500
C
      IF(IFLAG .EQ. 0 .AND. LABEL .NE. '.') THEN
        NBNSL = NBNSL + 1
        BNSL(NBNSL) = LABEL
        GO TO 600
      ENDIF
C
      RETURN
      END
C
C###############################################################################
C
      SUBROUTINE ALS
C
C     S = SEARCH FOR NEXT ENTRY WHICH MATCHES CURRENT SEARCH LABELS
C
      INCLUDE 'ALPCOM.FOR'
C
      INCLUDE 'ALCOM.FOR'
C
      WRITE(LUTOUT,
     & '(/'' STARTING SEARCH AT ENTRY SEQUENCE NUMBER '',I6)' )
     &     LESEQN+1
C
  100 CALL ALREAD(LUDF, LESEQN, EOF, ERRMSG)
C
      IF(EOF) THEN
         WRITE(LUTOUT,
     &   '(/'' ***** END OF FILE REACHED, NO MATCH FOUND *****'',
     &     /'' NOW AT LAST ENTRY IN FILE, SEQUENCE NUMBER '',I6)' )
     &     LESEQN
         RETURN
      ENDIF
C
      IF(ERRMSG .NE. ' ') THEN
        WRITE(LUTOUT, '('' ERROR: '', A)' ) ERRMSG
        RETURN
      ENDIF
C
      CALL ALCOMP(HSL, NHSL, BASL, NBASL, BNSL, NBNSL, MATCH)
      IF(.NOT. MATCH) GO TO 100
C
      WRITE(LUTOUT,
     &   '(/'' MATCH FOUND AT ENTRY SEQUENCE NUMBER '', I6)')LESEQN
C
      RETURN
      END
C
C###############################################################################
C
      SUBROUTINE ALG
C
C     G## = GO TO GIVEN ENTRY SEQUENCE NUMBER AND READ
C
C     N   = GO TO NEXT SEQUENTIAL ENTRY NUMBER AND READ
C
      INCLUDE 'ALPCOM.FOR'
C
      INCLUDE 'ALCOM.FOR'
C
C     GET DESIRED ENTRY NUMBER
C
      IF(CMND(2:) .EQ. ' ') GO TO 500
C
      READ(CMND(2:), '(BN,I10)', IOSTAT=IOS) IGSEQN
      IF(IOS .EQ. 0 .AND. IGSEQN .GT. 0) GO TO 10
C
      WRITE(LUTOUT, '(/'' ILLEGAL ENTRY NUMBER'')')
      RETURN
C
C     FOR ALN ENTRY JUST INCREMENT CURRENT SEQUENCE NUMBER
C
      ENTRY ALN
      IGSEQN = LESEQN + 1
C
C     RETURN IF WE ARE AT THIS SEQUENCE NUMBER ALREADY
C
   10 IF(IGSEQN .EQ. LESEQN) GO TO 500
C
      IF(IGSEQN .LT. LESEQN) THEN
        CALL ALR
      ENDIF
C
  100 CALL ALREAD(LUDF, LESEQN, EOF, ERRMSG)
C
      IF(EOF) THEN
         WRITE(LUTOUT,
     &   '(/'' END OF FILE AFTER ENTRY SEQUENCE NUMBER '',I6)')
     &    LESEQN
         RETURN
      ENDIF
C
      IF(ERRMSG .NE. ' ') THEN
        WRITE(LUTOUT, '('' ERROR: '', A)' ) ERRMSG
        RETURN
      ENDIF
C
      IF(LESEQN .NE. IGSEQN) GO TO 100
C
  500 WRITE(LUTOUT,
     &   '(/'' NOW AT ENTRY SEQUENCE NUMBER '', I6)' ) LESEQN
      RETURN
      END
C
C##############################################################################
C
      SUBROUTINE ALD
C
C     DISPLAY ENTRY AND SEARCH QUANTITIES
C
C     D{FEL!CS} = DISPLAY ITEMS DENOTED BY COMBINATION OF TRAILING
C                  SYMBOLS
C
C     F = FILE NAMES
C     E = LITERAL DISPLAY OF ENTRY LINES
C     L = DISPLAY PARSED ENTRY LABELS
C     ! = DISPLAY ENTRY COMMENT LINES
C     C = DISPLAY PARSED ENTRY COEFFICIENTS
C         (IF STANDARD ENTRY ACCESS LABEL, DISPLAY AS REAL NUMBERS)
C         (IF NON-STANDARD ACCESS LABEL, DISPLAY AS LITERAL ENTRY LINES)
C     S = DISPLAY SEARCH LABELS
C     * = ALL THE ABOVE
C
C------------------------------------------------------------------------------
C
      INCLUDE 'ALPCOM.FOR'
C
      INCLUDE 'ALCOM.FOR'
C
      LOGICAL STAR
C
      IF(INDEX(CMND, '*') .NE. 0) THEN
        STAR = .TRUE.
      ELSE
        STAR = .FALSE.
      ENDIF
C
C     SUFFIX = F; DISPLAY INPUT AND OUTPUT FILE NAMES
C
      IF(INDEX(CMND, 'F') .NE. 0 .OR.
     &   INDEX(CMND, 'f') .NE. 0 .OR. STAR) THEN
        WRITE(LUTOUT, '(/''       INPUT DATA FILE: '', A)' ) DFNAME
        INQUIRE(LUOF, OPENED=OK)
        IF(.NOT.OK) OFNAME = '**NONE**'
        WRITE(LUTOUT, '( ''      OUTPUT DATA FILE: '', A)' ) OFNAME
        WRITE(LUTOUT, '( '' QUERY DICTIONARY FILE: '', A)' ) QFNAME
        WRITE(LUTOUT, '( ''   EV OUTPUT DATA FILE: '', A)' ) EFNAME
      ENDIF
C
C     SUFFIX = S; DISPLAY SEARCH LABELS
C
      IF(INDEX(CMND, 'S') .NE. 0 .OR.
     &   INDEX(CMND, 's') .NE. 0 .OR. STAR) THEN
        WRITE(LUTOUT, '(1X)')
C
        CALL ALLCON(NHSL,HSL,'HSL',.TRUE.)
C
        CALL ALLCON(NBASL,BASL,'BASL',.FALSE.)
C
        CALL ALLCON(NBNSL,BNSL,'BNSL',.FALSE.)
C
      ENDIF
C
C     ENTRY QUANTITY DISPLAYS, ONLY IF A VALID ENTRY EXISTS
C
      WRITE(LUTOUT, '(/, '' ENTRY SEQUENCE NUMBER = '', I8)' ) LESEQN
      IF(LESEQN .EQ. 0) THEN
        WRITE(LUTOUT, '(/, '' NO ENTRY CURRENTLY READ IN'')' )
        RETURN
      ENDIF
C
C     SUFFIX = E; DISPLAY LITERAL ENTRY LINES
C
      IF(INDEX(CMND, 'E') .NE. 0 .OR.
     &   INDEX(CMND, 'e') .NE. 0 .OR. STAR) THEN
        WRITE(LUTOUT, '(1X)')
        DO 50 JLN = 1, NELN
        INCH = 70
        IF(EBUFF(JLN)(INCH+1:) .NE. ' ') INCH = LEN(EBUFF(JLN))
        WRITE(LUTOUT, '(1X,I3,''['',A,'']'')') JLN, EBUFF(JLN)(1:INCH)
   50   CONTINUE
      ENDIF
C
C     SUFFIX = L; DISPLAY PARSED ENTRY LABELS
C
      IF(INDEX(CMND, 'L') .NE. 0 .OR.
     &   INDEX(CMND, 'l') .NE. 0 .OR. STAR) THEN
        WRITE(LUTOUT, '(1X)')
C
        CALL ALLCON(NHL,HL,'HL',.TRUE.)
C
        CALL ALLCON(NBL,BL,'BL',.FALSE.)
      ENDIF
C
C     SUFFIX = !; DISPLAY COMMENT LINES
C
      IF(INDEX(CMND, '!') .NE. 0 .OR. STAR) THEN
        IF(NCMLN .EQ. 0) THEN
          WRITE(LUTOUT, '(1X, ''NO COMMENT LINES IN THIS ENTRY'')' )
        ELSE
          WRITE(LUTOUT, '(1X,A)') (EBUFF(J), J = LCMPTR, LCMPTR+NCMLN-1)
        ENDIF
      ENDIF
C
C     SUFFIX = C; DISPLAY COEFFICIENTS
C
      IF(INDEX(CMND, 'C') .NE. 0 .OR.
     &   INDEX(CMND, 'c') .NE. 0 .OR. STAR) THEN
        WRITE(LUTOUT, '(1X)')
C
        IF(NCFLN .EQ. 0) THEN
          WRITE(LUTOUT, '(1X,''NO COEFFICIENT LINES IN THIS ENTRY'')')
C
        ELSE IF(BL(1) .NE. '$') THEN
          WRITE(LUTOUT, '('' *** NONSTANDARD ACCESS LABEL *** '')' )
          WRITE(LUTOUT,
     &          '('' COEFFICIENT LINES OUTPUT WITHOUT CONVERSION''/)')
          WRITE(LUTOUT, '(1X, A)')
     &                          (EBUFF(J), J = LCFPTR, LCFPTR+NCFLN-1)
C
        ELSE
          CALL ALRECF(CF, NCF, NCFMX, ERRMSG)
          IF (FEXTN) THEN
            WRITE(LUTOUT, 300) (JCF, CF(JCF), JCF = 1, NCF)
  300       FORMAT(1X,'CF:',I4,'[', 1PE13.6, ']',I4,'[', 1PE13.6, ']',
     &             I4,'[', 1PE13.6, ']',I4,'[', 1PE13.6, ']')
          ELSE
            WRITE(LUTOUT, 400) (JCF, CF(JCF), JCF = 1, NCF)
  400       FORMAT(1X,'CF:',I4,'[', 1PE21.14, ']',I4,'[', 1PE21.14, ']')
          ENDIF
C
        ENDIF
      ENDIF
C
      RETURN
      END
C
C#######################################################################
C
C     SUBROUTINE ALEV IS CONTAINED IN A SEPERATE FILE TO ALLOW USE
C     OF CUSTOM ROUTINES ACCESSING DIFFERENT DATA TYPES
C
C#######################################################################
C
      SUBROUTINE ALR
C
C     R = REWIND INPUT DATA FILE
C
      INCLUDE 'ALPCOM.FOR'
      INCLUDE 'ALCOM.FOR'
C
      REWIND LUDF
      WRITE(LUTOUT, '('' DATA FILE REWOUND'')' )
      LESEQN = 0
      EOF = .FALSE.
      RETURN
      END
C
C###############################################################################
C
      SUBROUTINE ALF
C
C     F = CLOSE CURRENT INPUT DATA FILE (IF IT IS OPEN) AND OPEN A NEW ONE
C
      INCLUDE 'ALPCOM.FOR'
      INCLUDE 'ALCOM.FOR'
C
      INQUIRE(LUDF, OPENED=OK)
      IF(OK) THEN
        WRITE(LUTOUT, '('' CLOSING INPUT FILE '', A)' ) DFNAME
        CLOSE (LUDF)
      ENDIF
C
      WRITE(LUTOUT, '(/''$INPUT FILE NAME ? '')')
      READ(LUTIN, '(A)') DFNAME
C
      OPEN(UNIT=LUDF, FILE=DFNAME, STATUS='OLD', IOSTAT=IOPERR)
C
      IF(IOPERR .NE. 0) THEN
        WRITE(LUTOUT, '('' ERROR OPENING INPUT DATA FILE'')' )
        DFNAME = '**NONE**'
        OK = .FALSE.
        RETURN
      ENDIF
C
      OK = .TRUE.
      LESEQN = 0
      EOF = .FALSE.
      RETURN
      END
C
C###############################################################################
C
      SUBROUTINE ALOF
C
C     OF = CLOSE CURRENT OUTPUT DATA FILE (IF IT IS OPEN) AND OPEN A NEW ONE
C
      INCLUDE 'ALCOM.FOR'
C
      LOGICAL ALCIEQ
      EXTERNAL ALCIEQ
      CHARACTER*1 INA
C
      INQUIRE(LUOF, OPENED=OK)
      IF(OK) THEN
        WRITE(LUTOUT, '('' CLOSING OUTPUT FILE '', A)') OFNAME
        CLOSE (LUOF)
      ENDIF
C
      WRITE(LUTOUT, '(/''$NEW OUTPUT FILE NAME (C/R=NONE) ? '')')
      READ(LUTIN, '(A)') OFNAME
      IF(OFNAME .EQ. ' ') THEN
        OFNAME = '**NONE**'
        RETURN
      ENDIF
C
   10 WRITE(LUTOUT, '(''$NEW (N) OR APPEND (A) ? '')')
      READ(LUTIN, '(A)') INA
      IF(ALCIEQ(INA, 'N')) THEN
        OPEN(UNIT=LUOF, FILE=OFNAME, STATUS='NEW',
     &       IOSTAT=IOPERR)
      ELSE IF(ALCIEQ(INA, 'A')) THEN
        OPEN(UNIT=LUOF, FILE=OFNAME, STATUS='OLD', IOSTAT=IOPERR)
      ELSE
        WRITE(LUTOUT, '('' PLEASE RE-ENTER'')' )
        GO TO 10
      ENDIF
C
      IF(IOPERR .NE. 0) THEN
        WRITE(LUTOUT, '('' ERROR OPENING OUTPUT DATA FILE'')' )
        OK = .FALSE.
        RETURN
      ENDIF
C
      NFREC=0
      IF(ALCIEQ(INA, 'A')) THEN
C
C       COUNT THE NUMBER OF RECORDS IN THE FILE TO BE ABLE TO POSITION
C       THE FILE BEFORE THE END OF FILE.
C
  200   READ(LUOF, '(1X)', END=300)
        NFREC=NFREC+1
        GO TO 200
C
C       POSITION THE FILE BEFORE THE END OF FILE
C
  300   OK = .TRUE.
        REWIND LUOF
        DO 400 I=1,NFREC
           READ(LUOF, '(1X)')
  400   CONTINUE
      ENDIF
C
      RETURN
      END
C
C###############################################################################
C
      SUBROUTINE ALEF
C
C     EF = CLOSE CURRENT EVALUATED DATA OUTPUT FILE (IF IT IS OPEN)
C          AND OPEN A NEW ONE
C
      INCLUDE 'ALCOM.FOR'
C
      LOGICAL ALCIEQ
      EXTERNAL ALCIEQ
      CHARACTER*1 INA
C
      INQUIRE(LUEF, OPENED=OK)
      IF(OK) THEN
        WRITE(LUTOUT,
     &    '('' CLOSING EV DATA OUTPUT FILE '', A)') EFNAME
        CLOSE (LUEF)
      ENDIF
C
      WRITE(LUTOUT,
     &  '(/''$EV DATA OUTPUT FILE NAME (C/R=OUTPUT TO TERMINAL) ? '')')
      READ(LUTIN, '(A)') EFNAME
      IF(EFNAME .EQ. ' ') THEN
        EFNAME = '**NONE**'
        RETURN
      ENDIF
C
   10 WRITE(LUTOUT, '(''$NEW (N) OR APPEND (A) ? '')')
      READ(LUTIN, '(A)') INA
      IF(ALCIEQ(INA, 'N')) THEN
        OPEN(UNIT=LUEF, FILE=EFNAME, STATUS='NEW',
     &       IOSTAT=IOPERR)
      ELSE IF(ALCIEQ(INA, 'A')) THEN
        OPEN(UNIT=LUEF, FILE=EFNAME, STATUS='OLD', IOSTAT=IOPERR)
      ELSE
        WRITE(LUTOUT, '('' PLEASE RE-ENTER'')' )
        GO TO 10
      ENDIF
C
      IF(IOPERR .NE. 0) THEN
        WRITE(LUTOUT, '('' ERROR OPENING OUTPUT DATA FILE'')' )
        OK = .FALSE.
        RETURN
      ENDIF
C
      IF(ALCIEQ(INA, 'A')) THEN
C
C       COUNT THE NUMBER OF RECORDS IN THE FILE TO BE ABLE TO POSITION
C       THE FILE BEFORE THE END OF FILE.
C
  200   READ(LUEF, '(1X)', END=300)
        NFREC=NFREC+1
        GO TO 200
C
C       POSITION THE FILE BEFORE THE END OF FILE
C
  300   OK = .TRUE.
        REWIND LUEF
        DO 400 I=1,NFREC
           READ(LUEF, '(1X)')
  400   CONTINUE
      ENDIF
      RETURN
      END
C
C###############################################################################
C
      SUBROUTINE ALWR
C
C     WR = WRITE CURRENT ENTRY TO OUTPUT DATA FILE
C
      INCLUDE 'ALPCOM.FOR'
C
      INCLUDE 'ALCOM.FOR'
C
      IF(LESEQN .EQ. 0) THEN
        WRITE(LUTOUT, '(/'' NO ENTRY CURRENTLY READ IN'')' )
        RETURN
      ENDIF
C
C     WRITE CURRENT ENTRY TO OUTPUT DATA FILE
C
      INQUIRE(LUOF, OPENED=OK)
      IF(.NOT. OK) THEN
        WRITE(LUTOUT, '('' OUTPUT FILE NOT OPEN'')' )
        RETURN
      ENDIF
C
      WRITE(LUOF, '(A)') (EBUFF(J), J = 1, NELN)
C
      WRITE(LUTOUT, '(1X,I3,'' LINE ENTRY WRITTEN TO FILE: '',A)' )
     &        NELN, OFNAME
      RETURN
      END
C
C
C#######################################################################
C
      SUBROUTINE ALH
C
C     H = HELP
C
      INCLUDE 'ALCOM.FOR'
C
      WRITE(LUTOUT,
     &'(/'' H, {C/R}   HELP (SHOW THIS COMMAND SUMMARY)'')')
      WRITE(LUTOUT,
     &'('' {LABEL}?   QUERY THE ALADDIN DICTIONARY ABOUT {LABEL}'')')
      WRITE(LUTOUT,
     &'('' SL, L      SEARCH LABELS (DEFINE NEW SEARCH LABELS)'')')
      WRITE(LUTOUT,
     &'('' S          SEARCH FOR NEXT MATCHING ENTRY'')')
      WRITE(LUTOUT,
     &'('' G##        GO TO ENTRY AT SPECIFIED SEQUENCE NUMBER'')')
      WRITE(LUTOUT,
     &'('' N          NEXT (GO TO NEXT SEQUENTIAL ENTRY NUMBER)'')')
      WRITE(LUTOUT,
     &'('' D{FEL!CS*} DISPLAY TO TERMINAL ITEM(S) SPECIFIED BY'')')
      WRITE(LUTOUT,
     &'(''            SUFFIX CHARACTER(S): Files, Entry, Labels,'')')
      WRITE(LUTOUT,
     &'(''            !comments, Coefficients, Search labels,'')')
      WRITE(LUTOUT,
     &'(''            *all display fields'')')
      WRITE(LUTOUT,
     &'('' WR         WRITE CURRENT ENTRY TO OUTPUT ALADDIN FILE'')')
      WRITE(LUTOUT,
     &'('' EV         EVALUATE (COMPUTE) DATA POINTS FOR CURRENT '',
     &  ''ENTRY'')')
      WRITE(LUTOUT,
     &'('' R          REWIND INPUT ALADDIN DATA FILE'')')
      WRITE(LUTOUT,
     &'('' F          FILE (SELECT INPUT ALADDIN DATA FILE)'')')
      WRITE(LUTOUT,
     &'('' OF         OUTPUT FILE (SELECT WR COMMAND OUTPUT FILE)'')')
      WRITE(LUTOUT,
     &'('' EF         EV FILE (SELECT EV COMMAND OUTPUT DATA FILE)'')')
      WRITE(LUTOUT,
     &'('' QF         QUERY FILE (SELECT QUERY DICTIONARY FILE)'')')
      WRITE(LUTOUT,
     &'('' EX, EN     EXIT OR END ALADDIN'')' )
C
      RETURN
      END
C
C#######################################################################
C
      SUBROUTINE ALQMRK
C
C     ? IN COMMAND INDICATES STRING TO BE SEARCHED FOR FROM QUERY FILE
C
C
      INCLUDE 'ALCOM.FOR'
C
      CHARACTER*80 ILINE
      LOGICAL ALCIEQ
      EXTERNAL ALCIEQ
C
C     BLANK COMPRESS THE QUERY COMMAND
C
   50 IDX = INDEX(CMND, ' ')
      IF(IDX .NE. 0 .AND. CMND(IDX:) .NE. ' ') THEN
        CMND = CMND(:IDX-1) // CMND(IDX+1:)
        GO TO 50
      ENDIF
C
C     IF ? IS FIRST CHARACTER, SEND MESSAGE TO TERMINAL AND RETURN
C
      IF(CMND(1:1) .EQ. '?') THEN
        WRITE(LUTOUT,
     &  '(/'' USE {LABEL}? TO REFERENCE ALADDIN DICTIONARY'',
     &    /'' USE H OR C/R FOR ALADDIN COMMAND SUMMARY'')' )
      ENDIF
C
C     CHECK IF A QUERY FILE IS OPEN
C
      INQUIRE(LUQF, OPENED=OK)
      IF(.NOT. OK) THEN
        WRITE(LUTOUT,
     &  '(/'' NO QUERY DICTIONARY FILE; USE QF COMMAND TO OPEN ONE'')')
        RETURN
      ENDIF
C
C     REWIND QUERY FILE AND DO SEQUENTIAL SEARCH TO MATCH {LABEL?} STRING
C
      REWIND LUQF
C
  100 READ(LUQF, '(A)', IOSTAT=IOS, END=110) ILINE
  110 CONTINUE
      IF(IOS .LT. 0) THEN
        WRITE(LUTOUT, '(/'' NO REFERENCE FOUND IN DICTIONARY'')')
        RETURN
      ELSE IF(IOS .GT. 0) THEN
        WRITE(LUTOUT, '(/'' ERROR READING DICTIONARY FILE'')')
        RETURN
      ENDIF
C
C     BLANK COMPRESS THE DICTIONARY LINE BEFORE SEARCH COMPARISON
C
  120 IDX = INDEX(ILINE, ' ')
      IF(IDX .NE. 0 .AND. ILINE(IDX:) .NE. ' ') THEN
        ILINE = ILINE(:IDX-1) // ILINE(IDX+1:)
        GO TO 120
      ENDIF
C
      IF(.NOT. ALCIEQ(CMND, ILINE)) GO TO 100
C
C     REFERENCE FOUND IN QUERY DICTIONARY; OUTPUT TEXT
C     UNTIL LINE IS FOUND WITH '?' SIGNIFYING NEXT ENTRY, OR EOF
C
  150 READ(LUQF, '(A)', IOSTAT=IOS, END=170) ILINE
      IF(IOS .EQ. 0 .AND. INDEX(ILINE,'?') .EQ. 0) THEN
        IEND = 1
        DO 160 J = 1, LEN(ILINE)
        IF(ILINE(J:J) .NE. ' ') IEND = J
  160   CONTINUE
        WRITE(LUTOUT, '(1X,A)') ILINE(:IEND)
        GO TO 150
      ELSE IF(IOSTAT .GT. 0) THEN
        WRITE(LUTOUT, '(/'' ERROR READING DICTIONARY FILE'')' )
      ENDIF
C
  170 RETURN
      END
C
C#######################################################################
C
      SUBROUTINE ALQF
C
C     QF = SWITCH QUERY FILES
C
      INCLUDE 'ALPCOM.FOR'
      INCLUDE 'ALCOM.FOR'
C
      INQUIRE(LUQF, OPENED=OK)
      IF(OK) THEN
        WRITE(LUTOUT,
     &  '('' CLOSING QUERY DICTIONARY FILE '', A)' ) QFNAME
        CLOSE (LUQF)
      ENDIF
C
      WRITE(LUTOUT,
     & '(/''$QUERY DICTIONARY FILE NAME (C/R FOR NONE)? '')')
      READ(LUTIN, '(A)') QFNAME
      IF(QFNAME .EQ. ' ') THEN
        QFNAME = '**NONE**'
        RETURN
      ENDIF
C
      OPEN(UNIT=LUQF, FILE=QFNAME, STATUS='OLD', IOSTAT=IOPERR)
C
      IF(IOPERR .NE. 0) THEN
        WRITE(LUTOUT, '('' ERROR OPENING QUERY DICTIONARY FILE'')' )
        QFNAME = '**NONE**'
        RETURN
      ENDIF
C
      RETURN
      END
C
C#######################################################################
C
      SUBROUTINE ALEX
C
C     EN = EX  = END/EXIT RUN
C
      INCLUDE 'ALCOM.FOR'
C
C     CLOSE INPUT AND OUTPUT DATA FILES
C
      CLOSE (LUDF)
      CLOSE (LUOF)
      CLOSE (LUQF)
      CLOSE (LUEF)
      STOP
      END
C
C###############################################################################
C
      SUBROUTINE ALLCON(NIL,TEXTL,LHEAD,FNUMB)
C
C     LCON  = LABEL CONCATENATION AND PRINTING
C
C     NIL = NUMBER OF LABELS
C     TEXTL = ARRAY OF LABEL TEXT
C     LHEAD = CHARACTER STRING TO BE PUT AT BEGINNING OF OUTPUT LINE TO
C             IDENTIFY LABELS
C     FNUMB = FLAG TO INDICATE IF LABELS ARE TO BE PREFIXED BY
C             SEQUENTIAL NUMBER OF LABEL IN TEXTL
C
      INCLUDE 'ALCOM.FOR'
      INCLUDE 'ALPCOM.FOR'
C
      CHARACTER*40 TEXTL
      CHARACTER*(*) LHEAD
      LOGICAL FNUMB
      DIMENSION TEXTL(*)
C
C    INTEGER ARRAY LLABEL IS USED TO STORE THE LENGTHS OF LABELS
C    INTEGER ARRAY NEWLINE IS USED IN GENERATING CONCATENATE LINES OF
C    LABELS
C
      DIMENSION LLABEL(NHLMX),NEWLINE(40)
C
C     STORE THE LABEL LENGTHS AND DETERMINE WHICH LABEL STARTS A NEW
C     LINE
C
      NOLINES=1
      LLINE = 5
      DO 10 J = 1, NIL
        ILABEL = INDEX(TEXTL(J), ' ')
        LLABEL(J)=ILABEL-1
        LINC =  (ILABEL-1) + 5
        IF ((LLINE+LINC) .GT. 80) THEN
          NEWLINE(NOLINES) = J-1
          NOLINES = NOLINES + 1
          LLINE=5
        ENDIF
        LLINE = LLINE+LINC
   10   CONTINUE
        NEWLINE(NOLINES)=NIL
C
C     PRINT THE LINES OF LABEL TEXT
C
        ISTART=1
        DO 100 ILOOP=1,NOLINES
C
          IF (FNUMB) THEN
            WRITE(LUTOUT, 20)LHEAD,
     &        (I, TEXTL(I)(1:LLABEL(I)), I=ISTART,NEWLINE(ILOOP))
   20       FORMAT(1X,A,': ',20(I3,'[',A,']'))
          ELSE
            WRITE(LUTOUT, 30)LHEAD,
     &        (TEXTL(I)(1:LLABEL(I)), I=ISTART,NEWLINE(ILOOP))
   30       FORMAT(1X,A,': ',20(3X,A))
          ENDIF
C
        ISTART=NEWLINE(ILOOP) + 1
  100   CONTINUE
C
        WRITE(LUTOUT, '(1X)')
C
        RETURN
        END
C###################################################################
C
      INCLUDE 'ALEV.FOR'
      INCLUDE 'ALPACK.FOR'
      INCLUDE 'ALFLIB.FOR'
C
C###################################################################