      SUBROUTINE CKTAPE (LUNMT, IFERR, NEOF, LUNPR, LUNIN)
C+
C CHECK TAPE FOR ERRORS
C
C CALL SEQUENCE:  FORTRAN
C
C      CALL CKTAPE (LUNMT, IFERR, NEOF, LUNPR, LUNIN)
C
C      LUNMT  = (ENTRY) FORTRAN LUN ASSIGNED TO MAG. TAPE.
C      IFERR  = (ENTRY) MAG TAPE I/O ERROR CODE FROM -RDTAPE- SUBROUTINE
C               (RETURNS) +1 IF NO TAPE ERROR, OR IF WAS EOF/EOF
C                         UNCHANGED IF OTHER ERROR
C
C      NEOF   = (ENTRY, RETURN) CURRENT COUNT OF TAPE EOF READ.
C               (RETURN) VALUE OF 2 IF EOV WAS READ (IE.EOV)
C
C      LUNPR  = (ENTRY) FORTRAN LUN FOR PROMPT OUTPUT
C
C      LUNIN  = (ENTRY) FORTRAN LUN FOR INPUT RESPONSE FROM PROMPT
C
C OTHER ROUTINES NEEDED:   NONE
C
C 30-APR-81, W. BURTON
C-
C
C RETURN RIGHT AWAY IF NO ERROR
      IF (IFERR .GE. 0) GO TO 980
C
C IGNORE END-OF-REEL FOIL
      IF (IFERR .EQ. -62) GO TO 980
C
C CHECK FOR END-OF-FILE/END-OF-VOLUME
      IF (IFERR .NE. -11) GO TO 100
C
C GOT AN END OF VOLUME
      NEOF = 2
      GO TO 985
C
  100 CONTINUE
      IF (IFERR .NE. -10) GO TO 990
      NEOF = NEOF + 1
      GO TO 985
C
C NO ERROR, RESET EOF COUNTER
  980 CONTINUE
      NEOF = 0
  985 CONTINUE
      IFERR = 1
C
  990 CONTINUE
      RETURN
      END
      SUBROUTINE DCONV(DSTR, NCD, IAR, IFERR)
C+
C DCONV -- SUBROUTINE TO CONVERT DATE FROM DD-MMM-YY OR DDMMMYY
C          STRINGS TO MO, DAY, (YEAR-1900) IN INTEGER ARRAY
C
C CALL SEQUENCE:
C
C      CALL DCONV (DSTR, NCD, IAR, IFERR)
C
C INPUT ARGUMENTS:
C
C      DSTR   - CHARACTER STRING (BYTE ARRAY) OF DATE TO BE CONVERTED
C      NCD    - INTEGER NUMBER OF CHARACTERS IN STRING DSTR
C
C RETURN ARGUMENTS:
C
C      IAR    - INTEGER ARRAY (3 WORDS) WILL RECEIVE NUMERIC
C               EQUIVALENT OF DATE:  STORED AS 
C               IAR(1) = MONTH (1..12)
C               IAR(2) = DAY (1..32)
C               IAR(3) = YEAR-1900 (IE 1970 IS STORED AS 70)
C
C      IFERR  - STATUS RETURN CODE
C               +1 IF CONVERSION OK
C               -1 IF MONTH INVALID (MONTH MUST BE OF THE FORM:
C                     JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
C                     NO UPPERCASE CONVERSION INSIDE THIS ROUTINE.
C               -2 IF DAY INVALID (DAYS MUST BE BETWEEN 1 AND 32)
C               -3 IF YEAR INVALID
C
C OTHER ROUTINES REQUIRED:
C
C      IFSTEQ - ROUTINE FOR CHARACTER STRING MATCH
C
C-
      BYTE DSTR(1), MTBL(3,12)
      INTEGER IAR(3)
C
C TABLE OF ABBREVIATIONS FOR MONTHS
      DATA MTBL / 'J','A','N', 'F','E','B', 'M','A','R', 'A','P','R',
     1   'M','A','Y', 'J','U','N', 'J','U','L', 'A','U','G', 
     2   'S','E','P', 'O','C','T', 'N','O','V', 'D','E','C'/
C
C PARSE LINE BACKWARDS FROM YEAR
C
C ASSUME YEAR IS INVALID
      IFERR = -3
C
      N = NCD
      IAR(3) = 0
      M = 0
C
   10 CONTINUE
C
C IF RUN OUT DURING SCAN, RETURN WITH ERROR
      IF (N .LE. 0) GO TO 900
      I = DSTR(N) - "60    !"60 IS ASCII CHARACTER ZERO
C
C MUST BE NUMERIC CHARACTER (BETWEEN 0 AND 9) ELSE DONE WITH YEAR
      IF (I .LT. 0 .OR. I .GT. 9) GO TO 20
C
C NOT DONE YET, ADD TO BUILDING-UP VALUE
      IAR(3) = IAR(3) + I * (10**M)
      N = N - 1
      M = M + 1
      GO TO 10
C
C ERROR IF RAN OUT OF STRING BEFORE GETTING YEAR
   20 CONTINUE
      IF (M .EQ. 0) GO TO 900
C
C TRY NOW FOR MONTH, ASSUME ERROR
      IFERR = -1
C
C BACK UP OVER (-) IF ONE WAS FOUND
      IF (DSTR(N) .EQ. '-') N = N - 1
C
C BACK UP TO PRESUMED START OF MONTH
      N = N - 2
      IF (N .LE. 0) GO TO 900
C
C OK SO FAR, BEGIN LOOKING UP IN TABLE
      IAR(1) = 0
      DO 100 I = 1, 12
         IF (IFSTEQ(MTBL(1,I), DSTR(N), 3)) IAR(1) = I
  100 CONTINUE
C
C ERROR IF NOT FOUND
      IF (IAR(1) .EQ. 0) GO TO 900
C
C BEGIN WORKING ON DAY
      IFERR = -2
C
C BACK UP OVER (-) IF ONE IS PRESENT
      N = N - 1
      IF (N .LE. 0) GO TO 900
      IF (DSTR(N) .EQ. '-') N = N - 1
C
C DECODE DAY
      M = 0
      IAR(2) = 0
C
   30 CONTINUE
      IF (N .LE. 0) GO TO 40
      I = DSTR(N) - "60
      IF (I .LT. 0 .OR. I .GT. 9) GO TO 900
C
      IAR(2) = IAR(2) + I * (10**M)
      M = M + 1
      N = N - 1
      GO TO 30
C
C STRING IS ALL DONE, FINAL CHECK ON DAYS BEFORE DONE
   40 CONTINUE
      IF (IAR(2) .GT. 0 .AND. IAR(2) .LE. 32) IFERR = 1
C
C ALL DONE
  900 CONTINUE
      RETURN
      END
      INTEGER FUNCTION IDCMPR (ID1, ID2)
C+
C IDCMPR -- FUNCTION TO COMPARE 2 DATES STORED AS INTEGERS
C
C CALL SEQUENCE (FORTRAN FUNCTION):
C
C      J = IDCMPR (ID1, ID2)
C
C INPUT ARGUMENTS
C
C      ID1    - INTEGER ARRAY (3 WORDS) WITH DATE STORED AS
C               ID(1) = MONTH, ID(2) = DAY, ID(3) = YEAR
C
C      ID2    - SAME AS AVOBE FOR SECOND DATE
C
C RETURNS VALUE:
C
C      -1  - IF DATE-1 BEFORE DATE-2
C
C       0  - IF DATE-1 SAME AS DATE-2
C
C      +1  - IF DATE-1 AFTER DATE-2
C
C NO ERRORS DETECTED
C-
      INTEGER ID1(3), ID2(3), IPT(3)
C
C IPT GIVES ORDER IN WHICH TO TEST
      DATA IPT / 3, 1, 2/
C
C DO THE CHECKS PER TABLE
      DO 100 I = 1, 3
         J = IPT(I)
         IF (ID1(J) .LT. ID2(J)) GO TO 200
         IF (ID1(J) .GT. ID2(J)) GO TO 300
  100 CONTINUE
C
C FALLS THRU IF EXACTLY THE SAME
      IDCMPR = 0
      GO TO 900
C
C COME HERE AS SOON AS ONE WAS LESS
  200 CONTINUE
      IDCMPR = -1
      GO TO 900
C
C COME HERE AS SOON AS ONE WAS GREATER
  300 CONTINUE
      IDCMPR = 1
C
C ALWAYS COME HERE TO RETURN
  900 CONTINUE
      RETURN
      END
      SUBROUTINE RJUSTF (INS, NCL, NCR, OUTS, NCSL, NCSR, FILL)
C+
C THIS SUBROUTINE RIGHT JUSTIFIES AN INPUT STRING INTO AN OUTPUT STRING
C   AND FILLS THE EXTRA SPACES WITH A FILL CHARACTER.
C
C IT ALSO EXPANDS THE WILD-CARD SPECIFIER (*) INTO THE PROPER NUMBER
C    OF WILD-CHARACTER (?) CHARACTERS
C
C CALL SEQUENCE:
C     CALL RJUSTF (INS, NCL, NCR, OUTS, NCSL, NCSR, FILL)
C
C     INS    = (ENTRY) BYTE ARRAY WITH STRING TO BE COPIED
C     NCL    = (ENTRY) POSITION IN -INS- ARRAY TO START FROM (LEFT END)
C     NCR    = (ENTRY) POSITION IN -INS- ARRAY TO END ON (RIGHT END)
C     OUTS   = (RETURN) JUSTIFIED AND FILLED OUTPUT STRING
C     NCSL   = (RETURN) LEFT END OF TARGET STRING
C     NCSR   = (RETURN) RIGHT END OF TARGET STRING
C     FILL   = (ENTRY) BYTE TO USE AS THE FILL CHARACTER
C
C ERROR CONDITIONS:
C     NONE DETECTED.  NO WORK WILL BE DONE IF NCL .GT. NCR OR 
C     NCSL .GT. NCSR
C-
      LOGICAL*1 INS(1), OUTS(1), FILL, FLL
      LOGICAL*1 AS, QM
      DATA AS/'*'/, QM/'?'/
C
      FLL = FILL
      J = NCSR
      K = NCR
C
   10 CONTINUE
      IF (K .LT. NCL) GO TO 30
      IF (INS(K) .EQ. AS) GO TO 20
      IF (J .GE. NCSL) OUTS(J) = INS(K)
      K = K - 1
      J = J - 1
      IF (J .GE. NCSL) GO TO 10
      GO TO 900
C
   20 CONTINUE
      FLL = QM
C
   30 CONTINUE
      IF (J .LT. NCSL) GO TO 900
      OUTS(J) = FLL
      J = J - 1
      GO TO 30
C
  900 CONTINUE
      RETURN
      END
      SUBROUTINE NXTAPE (LUNOUT, LUNIN, LUNMT, IFERR)
C+
C THIS ROUTINE PROMPTS FOR AND SETS UP A MAGNETIC TAPE FOR LATER READS.
C
C CALLING SEQUENCE:  FORTRAN
C
C      CALL NXTAPE (LUNOUT, LUNIN, LUNMT, IFERR)
C
C      LUNOUT = (ENTRY) FORTRAN LUN FOR PROMPTING OUTPUT
C      LUNIN  = (ENTRY) FORTRAN LUN FOR RESPONSE INPUT
C      LUNMT  = (ENTRY) FORTRAN LUN TO BE ASSIGNED TO MAGTAPE.
C
C      IFERR  = (ENTRY) IF -999 ON ENTRY, NO REWIND-UNLOAD WILL BE DONE
C                       BEFORE PROMPT
C               (RETURNS) ERROR FLAG
C                          1 - TAPE ASSIGNED OK
C                        -10 - END-OF-FILE (CTRL-Z) DURING PROMPT
C
C OTHER ROUTINES REQUIRED:
C
C      WTQIO  = SYSTEM ROUTINE FOR CONTROL OF MAG-TAPE UNIT
C      MIN    = FORTRAN MINIMUM ROUTINE
C      ASSIGN = SYSTEM ASSIGN DEVICE TO LUN.
C      UPCASE = LOWER TO UPPER CASE CONVERSION
C
C 28-AUG-81 , WB-003 DO NOT UNLOAD AFTER REWIND
C 22-JUN-81, WB-001 PROMPT FOR TAPE DENSITY
C 30-APR-81, W. BURTON
C-
C MAG TAPE OPERATION CODES
      PARAMETER IOATT="1400, IODET="2000, IORWD="2400, IORWU="2540,
     1   IOSEC="2520, IOSTC="2500
C PARAMETER FOR HI-DENSITY CORE DUMP, AND 1600 BPI
      PARAMETER NDENS=4, IDENS=2048
      BYTE TAPE(4), IOST, ANS
      INTEGER IOSB(2), IPRL(6)
C
      EQUIVALENCE (IOST,IOSB(1))
C
C SKIP REWIND-DETACH IF INITIALIZATION CALL
      IF (IFERR .EQ. -999) GO TO 10
C REWIND
C WB-003 DO NOT UNLOAD
      CALL WTQIO (IORWD, LUNMT, LUNMT, 0)
C DETACH
      CALL WTQIO (IODET, LUNMT, LUNMT, 0)
C
C CANCEL PREVIOUS ASSIGNMENTS
      CALL ASSIGN (LUNMT)
      WRITE (LUNOUT,1000)
 1000 FORMAT (1H0, 'LOAD NEXT INPUT TAPE')
C
   10 CONTINUE
      WRITE (LUNOUT, 1001)
 1001 FORMAT (1H$, 'ENTER TAPE INPUT UNIT [DDU:]   ')
      READ (LUNIN, 2000, END=900, ERR=10) NQT, (TAPE(I), I=1,MIN(4,NQT))
      CALL UPCASE (TAPE, 4)
 2000 FORMAT (Q, 4A1)
      IF (NQT .NE. 4) GO TO 10
C
C WB-001, PROMPT FOR DENSITY
   11 CONTINUE
      WRITE (LUNOUT,1002)
 1002 FORMAT (1H$, 5X, 'TAPE DENSITY (800 OR 1600 BPI)? [I]   ')
      READ (LUNIN,2001, END=900, ERR=11) KDENS
 2001 FORMAT (I5)
      JDENS=NDENS
      IF (KDENS .EQ. 1600) JDENS=IDENS
C CHANGE DEVICE ASSIGNMENTS
      CALL ASSIGN (LUNMT, TAPE, 4)
C
C TRY TO ATTACH DEVICE, CHECK RETURN STATUS TOO
      CALL WTQIO (IOATT, LUNMT, LUNMT, 0, IOSB,,IDS)
      IF (IOST .GT. 0 .AND. IDS .GT. 0) GO TO 20
C
C FAILED TO ATTACH, PROMPT ABOUT WHAT TO DO
      WRITE (LUNOUT, 1003) IOST
 1003 FORMAT (1H$, 2X, 'FAILED TO ATTACH, IOSTAT=', I3, '. CONTINUE',
     1   ' ANYWAY? [Y/N]   ')
      READ (LUNIN, 2002, END=900, ERR=900) ANS
      CALL UPCASE (ANS, 1)
 2002 FORMAT (A1)
      IF ((ANS .AND. "177) .NE. 'Y') GO TO 900
C
C DO AN INSURANCE REWIND
   20 CONTINUE
      CALL WTQIO (IORWD, LUNMT, LUNMT, 0)
C
C SET DENSITY OF TM-11 (HI-DENSITY AND/OR CORE DUMP)
      CALL WTQIO (IOSTC, LUNMT, LUNMT, 0, IOSB, JDENS)
C
C SET AN OK RETURN
      IFERR = 1
      GO TO 990
C
  900 CONTINUE
      IFERR = -10
  990 CONTINUE
      RETURN
      END
      SUBROUTINE PARSE (NQIN, INLINE, TUIC, TFILEN, IFWILD, IFERR)
C+
C PARSE.FTN
C
C THIS ROUTINE PARSES A FILE SPECIFIER STRING FROM -INLINE- AND RETURNS
C   THE EXPANDED UIC IN ARRAY -TUIC-.  THE REST OF THE FILE SPECIFIER
C   RETURNS TO -TFILEN-
C
C LOGICAL FLAG -IFWILD- IS SET TRUE IF THE STRING CONTAINS A WILDCARD
C
C CALL SEQUENCE:
C
C      CALL PARSE (N, INLINE, TUIC, TFILEN, IFWILD, IFERR)
C
C     N      = (ENTRY) NUMBER OF CHARACTERS STORED IN -INLINE-
C     INLINE = (ENTRY) BYTE ARRAY CONTAINING FILESPECIFIER STRING TO BE
C              PARSED.  THE LINE MUST HAVE ALL FIELDS SPECIFIED
C              (IE.  [I,J].;N)  THERE ARE NO DEFAULTS.  FIELDS MAY
C              CONTAIN WILD CHARACTERS OR WILD CARDS.  THE VERSION
C              NUMBER FIELD MUST NOT BE NULL.
C     TUIC   = (RETURN) BYTE ARRAY FOR RETURN OF PARSED AND EXPANDED UIC
C                     STRING.  RETURNS OF THE FORM [NNN,MMM]
C                     WHERE NNN = GROUP NUMBER OR ??? IF WILDCARD
C                           MMM = MEMBER NUMBER OR ???
C     TFILEN = (RETURN) BYTE ARRAY FOR THE FILENAME STRING, PARSED AND
C                       EXPANDED TO
C                       9.3;6 CHARACTERS WITH NULL AT END.
C                       WILDCARDS ARE STORED AS STRING OF ?
C     IFWILD = (RETURN) LOGICAL VALUE .TRUE. IF A WILD CARD WAS FOUND
C                       NOT SET FOR WILD CHARACTERS
C     IFERR  = (RETURN) STATUS RETURN
C                       +1 IF PARSE WAS OK
C                       -1 IF SYNTAX ERROR FOUND DURING PARSE.
C
C ERROR CONDITIONS:
C   1. THE INPUT STRING MUST BE OF THE FORM [N,M]NAME.EXT;VER
C      N = 3 DIGIT GROUP NUMBER
C      M = 3 DIGIT MEMBER NUMBER
C      NAME = FILE NAME (9 CHARACTERS MAX)
C      EXT = FILE EXTENSION (3 CHARACTERS MAX)
C      VER = 6 CHARACTER OCTAL VERSION NUMBER.
C
C      WILDCARD CHARACTER (*) CAN BE USED FOR ANY FIELD
C      WILD CHARACTER (?) CAN BE USED TO MATCH ANY CHARACTER
C
C-
      LOGICAL*1 INLINE(1), TUIC(1), TFILEN(1)
      LOGICAL*1 STX(5), AS, CM, DT, LB, NL, QM, RB, SC, SP, ZE
      INTEGER IPTR(5)
      LOGICAL IFWILD
      EQUIVALENCE (NCLB,IPTR(1)), (NCCM,IPTR(2)), (NCRB,IPTR(3)),
     1   (NCDT,IPTR(4)), (NCSC,IPTR(5))
      EQUIVALENCE (LB,STX(1)), (CM,STX(2)), (RB,STX(3)), (DT,STX(4)),
     1   (SC,STX(5))
C
C SET UP CHARACTERS AND POINTERS FOR SYNTAX CHECK
      DATA STX/ '[', ',', ']', '.', ';'/
      DATA AS/'*'/, NL/0/, QM/'?'/, SP/' '/, ZE/'0'/
C
C ASSUME NO WILDCARDS
      IFWILD = .FALSE.
C
C PUT CONSTANT CHARACTERS INTO TARGET STRING
      DO 100 I = 1,9
         TUIC(I) = SP
  100 CONTINUE
      TUIC(1) = LB
      TUIC(5) = CM
      TUIC(9) = RB
C
      DO 110 I = 1,20
         TFILEN(I) = SP
  110 CONTINUE
      TFILEN(10) = DT
      TFILEN(14) = SC
      TFILEN(21) = NL
C
C CHECK FOR WILDCARDS ANYWHERE IN INPUT STRING
      IF (ICPOS(INLINE, 1, NQIN, AS) .NE. 0) IFWILD = .TRUE.
C
C PRELIMINARY SCAN FOR SYNTAX
      LEFT = 1
      DO 200 I=1,5
C
C     WORK LEFT-TO-RIGHT, SCAN FOR CHARACTERS IN STX LIST
         IPTR(I) = ICPOS(INLINE, LEFT, NQIN, STX(I))
         IF (IPTR(I) .EQ. 0) GO TO 800
         LEFT = IPTR(I) + 1
C
C LOOK AGAIN TO BE SURE WE HAVE EXACTLY ONE OCCURRENCE
C   IF DUPLICATE OCCURRENCE, SYNTAX ERROR
         IF (ICPOS(INLINE, LEFT, NQIN, STX(I)) .NE. 0) GO TO 800
  200 CONTINUE
C
C MAKE SURE SPACE IS LEFT FOR VERSION NUMBER
      IF (NCSC .EQ. NQIN) GO TO 800
C PROCESS THE UIC
C
C NCRB=POSITION OF RIGHT BRACKET, NCCM=POSITION OF COMMA
C NCLB = POSITION OF LEFT BRACKET.
C
C RIGHT JUSTIFY EACH UIC FIELD INTO TARGET STRING
      CALL RJUSTF (INLINE, NCCM+1, NCRB-1, TUIC, 6, 8, ZE)
      CALL RJUSTF (INLINE, NCLB+1, NCCM-1, TUIC, 2, 4, ZE)
C
C LEFT JUSTIFY FILE NAME INTO NAME FIELD, BLANK FILL AND EXPAND * TO ???
      CALL LJUSTF (INLINE, NCRB+1, NCDT-1, TFILEN, 1, 9, SP)
C
C LEFT JUSTIFY FILE EXTENSION SIMILARLY
      CALL LJUSTF (INLINE, NCDT+1, NCSC-1, TFILEN, 11, 13, SP)
C
C RIGHT JUSTIFY VERSION NUMBER WITH SPACE FILL
      CALL RJUSTF (INLINE, NCSC+1, NQIN, TFILEN, 15, 20, SP) 
C AT THIS POINT THE ARRAY -TUIC- SHOULD HAVE [NNN,NNN] OR [???,???]
C AND TFILEN FFFFFFFFF.EEE;     N<NULL>
C OR         ?????????.???;??????<NULL>   OR SOME COMBINATION.
C
C MARK NO ERROR
      IFERR = 1
      GO TO 900
C
C MARK A SYNTAX ERROR
  800 CONTINUE
      IFERR = -1
C
  900 CONTINUE
      RETURN
      END
      SUBROUTINE RDTAPE (LUN, NBYTES, BUF, IFERR)
C+
C RDTAPE.FTN
C
C THIS SUBROUTINE DOES EXECUTIVE-LEVEL (QIO) READS FROM MAGNETIC TAPE
C  DIRECTLY INTO THE USER TASK
C
C CALLING SEQUENCE:     CALL RDTAPE (LUN, NBYTES, BUF, IFERR)
C
C INPUT ARGUMENTS:     LUN = THE LOGICAL UNIT NUMBER ASSIGNED TO THE
C                             INPUT MAGNETIC TAPE (INTEGER)
C                      NBYTES = THE NUMBER OF BYTES TO TRY TO READ.
C                               ** WARNING ** THE ACTUAL BYTE COUNT
C                           IS RETURNED TO NBYTES, DO NOT USE A
C                               CONSTANT AS AN ACTUAL ARGUMENT.
C RETURN ARGUMENTS:    BUF = ARRAY INTO WHICH BYTES ARE PUT
C                      IFERR = STATUS RETURN
C                               +1 = SUCCESS
C                               -N = OPERATION ERROR CODE (SEE FCS)
C                               -N-1000 = DIRECTIVE ERROR CODE
C
C SUBROUTINES REQUIRED:
C
C      GETADR = SYSTEM ROUTINE TO RETURN ADDRESS OF ARGUMENT
C      WTQIO  = SYSTEM LEVEL I/O CALL TO OPERATE TAPE.
C-
C
      PARAMETER IORLB=512
      BYTE BUF(1), IOSTAT
      INTEGER IOSB(2), IPRL(6)
      EQUIVALENCE (IOSB(1), IOSTAT)
C
C ASSUME SUCCESSFUL COMPLETION
      IFERR = 1
C
C SET UP PARAMETERS FOR QIO CALL, START ADDRESS
      CALL GETADR(IPRL(1), BUF(1))
C   NUMBER OF BYTES TO TRY
      IPRL(2) = NBYTES
C
C CALL THE EXECUTIVE AND WAIT FOR COMPLETION OF READ
      CALL WTQIO (IORLB, LUN, LUN, 0, IOSB, IPRL, IDS)
C
C CHECK FOR A DIRECTIVE ERROR (-N)
      IF (IDS  .LE. 0) GO TO 800
C
C NOT DIRECTIVE ERROR, CHECK FOR DRIVER ERROR, BR IF NOT
      IF (IOSTAT .GT. 0) GO TO 900
         IFERR = IOSTAT
         GO TO 900
C
  800 CONTINUE
      IFERR = IDS-1000
C
  900 CONTINUE
      NBYTES = IOSB(2)
      RETURN
      END
      SUBROUTINE LJUSTF (INS, NCL, NCR, OUTS, NCSL, NCSR, FILL)
C+
C THIS SUBROUTINE LEFT JUSTIFIES AN INPUT STRING INTO AN OUTPUT STRING
C   AND FILLS THE EXTRA SPACES WITH A FILL CHARACTER.
C
C IT ALSO EXPANDS THE WILD-CARD SPECIFIER (*) INTO THE PROPER NUMBER
C    OF WILD-CHARACTER (?) CHARACTERS
C
C CALL SEQUENCE:
C     CALL LJUSTF (INS, NCL, NCR, OUTS, NCSL, NCSR, FILL)
C
C     INS    = (ENTRY) BYTE ARRAY WITH STRING TO BE COPIED
C     NCL    = (ENTRY) POSITION IN -INS- ARRAY TO START FROM (LEFT END)
C     NCR    = (ENTRY) POSITION IN -INS- ARRAY TO END ON (RIGHT END)
C     OUTS   = (RETURN) JUSTIFIED AND FILLED OUTPUT STRING
C     NCSL   = (RETURN) LEFT END OF TARGET STRING
C     NCSR   = (RETURN) RIGHT END OF TARGET STRING
C     FILL   = (ENTRY) BYTE TO USE AS THE FILL CHARACTER
C
C ERROR CONDITIONS:
C     NONE DETECTED.  NO WORK WILL BE DONE IF NCL > NCR OR 
C     NCSL > NCSR
C-
      LOGICAL*1 INS(1), OUTS(1), FILL, FLL
      LOGICAL*1 AS, QM
      DATA AS/'*'/, QM/'?'/
C
      FLL = FILL
      J = NCSL
      K = NCL
C
   10 CONTINUE
      IF (K .GT. NCR) GO TO 30
      IF (INS(K) .EQ. AS) GO TO 20
      IF (J .LE. NCSR) OUTS(J) = INS(K)
      K = K + 1
      J = J + 1
      IF (J .LE. NCSR) GO TO 10
      GO TO 900
C
   20 CONTINUE
      FLL = QM
   30 CONTINUE
      IF (J .GT. NCSR) GO TO 900
      OUTS(J) = FLL
      J = J + 1
      GO TO 30
C
  900 CONTINUE
      RETURN
      END
