C    Copyright(C) 1999-2020 National Technology & Engineering Solutions
C    of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C    NTESS, the U.S. Government retains certain rights in this software.
C
C    See packages/seacas/LICENSE for details

      SUBROUTINE DELFSQ (MP, ML, MS, MR, MSC, MCOM, ICOM, JCOM, CIN,
     &   RIN, IIN, KIN, N, IPBOUN, ILBOUN, ISBOUN, NLPS, IFLINE, ILLIST,
     &   NSPR, IFSIDE, ISLIST, IRPB, IPBF, NPPF, IFPB, LISTPB, ILBF,
     &   NLPF, IFLB, LISTLB, ISBF, NSPF, IFSB, LISTSB, LINKP, LINKL,
     &   LINKS, LINKB, LINKR, LINKSC, LINKPB, LINKLB, LINKSB, IWTPBF,
     &   IWTLBF, IWTSBF, IFHOLE, NHPR, IHLIST, IRGFLG, NUMBER, DEFSCH,
     &   OPTIM, VAXVMS, WROTE, TIME1, BATCH, VERSN)
C***********************************************************************

C  SUBROUTINE DELFSQ = DELETES POINTS, LINES, REGIONS, SCHEMES, AND
C                      BOUNDARY DEFINITIONS

C***********************************************************************

C  SUBROUTINE CALLED BY:
C     FASTQ = A PROGRAM TO QUICKLY PREPARE QMESH INPUT

C***********************************************************************

C  VARIABLES USED:
C     IANS   = LOGICAL RESPONSE FROM YES-NO QUESTION
C     ANS    = CHARACTER RESPONSE FOR MENU CHOICE

C***********************************************************************

      DIMENSION IPBOUN(MP), ILBOUN(ML), ISBOUN(ML)
      DIMENSION NLPS(MS), IFLINE(MS), ILLIST(MS*3)
      DIMENSION NSPR(MR), IFSIDE(MR), ISLIST(4*MR), IRPB(MR)
      DIMENSION IPBF(MP), NPPF(MP), IFPB(MP), LISTPB(2, MP)
      DIMENSION ILBF(ML), NLPF(ML), IFLB(ML), LISTLB(2, ML)
      DIMENSION ISBF(ML), NSPF(ML), IFSB(ML), LISTSB(2, ML)
      DIMENSION IWTPBF(3, MP), IWTLBF(3, ML), IWTSBF(3, ML)
      DIMENSION LINKP(2, MP), LINKL(2, ML), LINKS(2, MS), LINKB(2, MS)
      DIMENSION LINKR(2, MR), LINKSC(2, MR), LINKPB(2, MP)
      DIMENSION LINKLB(2, ML), LINKSB(2, ML), NUMBER(MSC)
      DIMENSION IFHOLE(MR), NHPR(MR), IHLIST(MR*2), IRGFLG(MR)
      DIMENSION N(29)
      DIMENSION KIN(MCOM), CIN(MCOM), IIN(MCOM), RIN(MCOM)

      CHARACTER*72 DEFSCH, CIN
      CHARACTER VERSN*9, NUMBER*80

      LOGICAL OPTIM, ADDLNK, VAXVMS, WROTE, SIDEOK, BATCH, NOROOM
      LOGICAL LGROUP

      ADDLNK = .TRUE.
      IZ = 0

  100 CONTINUE
      IF (ICOM .GT. JCOM) THEN
         CALL MESSAGE(' ')
         CALL FREFLD (IZ, IZ, 'ENTER DELETE OPTION: ', MCOM, IOSTAT,
     &      JCOM, KIN, CIN, IIN, RIN)
         ICOM = 1
      END IF

      IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR. (CIN(ICOM)(1:1) .EQ. 'p')) THEN
         ICOM = ICOM + 1
         IF (N(1) .GT. 0) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE POINTS <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  110       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(18))
               DO 120 I = I1, I2
                  CALL LTSORT (MP, LINKP, I, IZ, ADDLNK)
  120          CONTINUE
               GO TO 110
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*-----------------------------------*')
            CALL MESSAGE('* NO POINTS IN THE CURRENT DATABASE *')
            CALL MESSAGE('*-----------------------------------*')
         END IF

      ELSE IF ((CIN(ICOM)(1:1) .EQ. 'L') .OR.
     &   (CIN(ICOM)(1:1) .EQ. 'l')) THEN
         ICOM = ICOM + 1
         IF (N(2) .GT. 0) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE LINES <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  130       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(19))
               DO 140 I = I1, I2
                  CALL LTSORT (ML, LINKL, I, IZ, ADDLNK)
  140          CONTINUE
               GO TO 130
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*----------------------------------*')
            CALL MESSAGE('* NO LINES IN THE CURRENT DATABASE *')
            CALL MESSAGE('*----------------------------------*')
         END IF

C  DELETE BAR SET DEFINITIONS

      ELSE IF ((CIN(ICOM)(1:2) .EQ. 'BA') .OR.
     &   (CIN(ICOM)(1:2) .EQ. 'ba')) THEN
         ICOM = ICOM + 1
         IF (N(5) .GT. 0) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE BAR SETS <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  150       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(21))
               DO 160 I = I1, I2
                  CALL LTSORT (MS, LINKB, I, IZ, ADDLNK)
  160          CONTINUE
               GO TO 150
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*-------------------------------------*')
            CALL MESSAGE('* NO BAR SETS IN THE CURRENT DATABASE *')
            CALL MESSAGE('*-------------------------------------*')
         END IF

C  DELETE THE RENUMBERING CARDS

      ELSE IF ((CIN(ICOM)(1:3) .EQ. 'REN') .OR.
     &   (CIN(ICOM)(1:3) .EQ. 'ren')) THEN
         ICOM = ICOM + 1
         IF (N(28) .GT. 0) THEN
            CALL MESSAGE(' ')
            I1 = 1
            I2 = N(28)
            ITEST = 20
            DO 170 I = I1, I2
               WRITE(*, 10040) I, NUMBER(I)(1:72)
               IF (NUMBER(I)(73:80) .NE.'        ') THEN
                  WRITE(*, 10050) NUMBER(I)(73:80)
               END IF
  170       CONTINUE
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE RENUMBER CARDS <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  180       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(28))
               DO 200 I = I1, I2
                  DO 190 J = I, N(28)
                     NUMBER(J) = NUMBER(J + 1)
  190             CONTINUE
                  N(28) = N(28) - 1
  200          CONTINUE
               IF (N(28) .EQ. 0) OPTIM = .FALSE.
               GO TO 180
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE
     &         ('*-------------------------------------------*')
            IF (.NOT. OPTIM) CALL MESSAGE
     &         ('*        NO RENUMBER CONTROL CARDS          *')
            CALL MESSAGE
     &         ('*        OPTIMIZATION HAS BEEN DISABLED     *')
            CALL MESSAGE
     &         ('*-------------------------------------------*')
            CALL MESSAGE(' ')
            OPTIM = .FALSE.
         END IF

C  DELETE THE REGIONS

      ELSE IF ((CIN(ICOM)(1:1) .EQ. 'R') .OR.
     &   (CIN(ICOM)(1:1) .EQ. 'r')) THEN
         ICOM = ICOM + 1
         LGROUP = .TRUE.
         DO 210 J = 1, N(7)
            IF (IRGFLG(J) .LE. -1) THEN
               LGROUP = .FALSE.
               GO TO 220
            END IF
  210    CONTINUE
  220    CONTINUE
         IF (.NOT.LGROUP) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE REGIONS <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  230       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(22))
               DO 320 I = I1, I2
                  ADDLNK = .FALSE.
                  CALL LTSORT (MR, LINKR, I, IPTR, ADDLNK)
                  IF ((IPTR .GT. 0) .AND. (IRGFLG(IPTR) .LE. 0)) THEN

C  DELETE REGION FROM BODY LIST

                     DO 250 J = 1, N(9)
                        IF (IRPB(J) .EQ. I) THEN
                           DO 240 K = J + 1, N(9)
                              IRPB(K - 1) = IRPB(K)
  240                      CONTINUE
                           N(9) = N(9) - 1
                        END IF
  250                CONTINUE

C  DELETE REGION FROM GROUPS

                     DO 280 J = 1, N(7)
                        IF (IRGFLG(J) .GE. 1) THEN
                           K1 = IFSIDE(IPTR)
                           K2 = K1 + NSPR(IPTR) - 1
                           DO 270 K = K1, K2
                              IF (ISLIST(K) .EQ. I) THEN
                                 DO 260 L = K + 1, K2
                                    ISLIST(K - 1) = ISLIST(K)
  260                            CONTINUE
                                 NSPR(IPTR) = NSPR(IPTR) - 1
                              END IF
  270                      CONTINUE
                        END IF
  280                CONTINUE

C  DELETE REGION FROM HOLES

                     DO 310 J = 1, N(7)
                        IF (NHPR(J) .GE. 1) THEN
                           K1 = IFHOLE(IPTR)
                           K2 = K1 + NHPR(IPTR) - 1
                           DO 300 K = K1, K2
                              IF (IHLIST(K) .EQ. I) THEN
                                 DO 290 L = K + 1, K2
                                    IHLIST(K - 1) = IHLIST(K)
  290                            CONTINUE
                                 NHPR(IPTR) = NHPR(IPTR) - 1
                              END IF
  300                      CONTINUE
                        END IF
  310                CONTINUE

C  DELETE LINK TO REGION

                     ADDLNK = .TRUE.
                     CALL LTSORT (MR, LINKR, I, IZ, ADDLNK)
                  END IF
  320          CONTINUE
               ADDLNK = .TRUE.
               GO TO 230
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*------------------------------------*')
            CALL MESSAGE('* NO REGIONS IN THE CURRENT DATABASE *')
            CALL MESSAGE('*------------------------------------*')
         END IF

C  DELETE THE GROUPS

      ELSE IF ((CIN(ICOM)(1:1) .EQ. 'G') .OR.
     &   (CIN(ICOM)(1:1) .EQ. 'g')) THEN
         ICOM = ICOM + 1
         LGROUP = .FALSE.
         DO 330 J = 1, N(7)
            IF (IRGFLG(J) .GE. 1) THEN
               LGROUP = .TRUE.
               GO TO 340
            END IF
  330    CONTINUE
  340    CONTINUE
         IF (LGROUP) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE GROUPS<I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  350       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(22))
               DO 380 I = I1, I2
                  ADDLNK = .FALSE.
                  CALL LTSORT (MR, LINKR, I, IPTR, ADDLNK)
                  IF ((IPTR .GT. 0) .AND. (IRGFLG(IPTR) .GE. 1)) THEN

C  DELETE GROUP FROM BODY LIST

                     DO 370 J = 1, N(9)
                        IF (IRPB(J) .EQ. I) THEN
                           DO 360 K = J + 1, N(9)
                              IRPB(K - 1) = IRPB(K)
  360                      CONTINUE
                           N(9) = N(9) - 1
                        END IF
  370                CONTINUE

C  DELETE LINK TO GROUP

                     ADDLNK = .TRUE.
                     CALL LTSORT (MR, LINKR, I, IZ, ADDLNK)
                  END IF
  380          CONTINUE
               ADDLNK = .TRUE.
               GO TO 350
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*-----------------------------------*')
            CALL MESSAGE('* NO GROUPS IN THE CURRENT DATABASE *')
            CALL MESSAGE('*-----------------------------------*')
         END IF

C  DELETE THE HOLES

      ELSE IF ((CIN(ICOM)(1:2) .EQ. 'HO') .OR.
     &   (CIN(ICOM)(1:2) .EQ. 'ho')) THEN
         ICOM = ICOM + 1
         IF (N(29) .GT. 0) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE HOLES FOR REGIONS <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  390       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(22))
               ADDLNK = .FALSE.
               DO 400 I = I1, I2
                  CALL LTSORT (MR, LINKR, I, L, ADDLNK)
                  IF (L .GT. 0) THEN
                     IF (NHPR(L) .GT. 0) THEN
                        NHPR(L) = 0
                     ELSE
                        WRITE (*, 10000) I
                     END IF
                  ELSE
                     WRITE (*, 10010) I
                  END IF
  400          CONTINUE
               ADDLNK = .TRUE.
               GO TO 390
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*----------------------------------*')
            CALL MESSAGE('* NO HOLES IN THE CURRENT DATABASE *')
            CALL MESSAGE('*----------------------------------*')
         END IF

C  DELETE SCHEMES

      ELSE IF ((CIN(ICOM)(1:2) .EQ. 'SC') .OR.
     &   (CIN(ICOM)(1:2) .EQ. 'sc')) THEN
         ICOM = ICOM + 1
         IF (N(10) .GT. 0) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE SCHEMES <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  410       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(24))
               DO 420 I = I1, I2
                  CALL LTSORT (MR, LINKSC, I, IZ, ADDLNK)
  420          CONTINUE
               GO TO 410
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE
     &         ('*---------------------------------------------*')
            CALL MESSAGE
     &         ('* ONLY DEFAULT SCHEME IN THE CURRENT DATABASE *')
            CALL MESSAGE
     &         ('*---------------------------------------------*')
            WRITE(*, 10020) DEFSCH
            CALL MESSAGE(' ')
         END IF

C  SPAWN A PROCESS

      ELSE IF ((CIN(ICOM)(1:2) .EQ. 'SP') .OR.
     &   (CIN(ICOM)(1:2) .EQ. 'sp')) THEN
         ICOM = ICOM + 1
         CALL SPAWN (VAXVMS)

C  DELETE SIDE DEFINITIONS

      ELSE IF ((CIN(ICOM)(1:1) .EQ. 'S') .OR.
     &   (CIN(ICOM)(1:1) .EQ. 's')) THEN
         ICOM = ICOM + 1
         IF (N(3) .GT. 0) THEN
            CALL MESSAGE(' ')
            CALL MESSAGE('DELETE SIDES <I1> THROUGH <I2>:')
            CALL MESSAGE('HIT A RETURN TO END')
  430       CONTINUE
            IF (ICOM .GT. JCOM) THEN
               CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN, CIN,
     &            IIN, RIN)
               ICOM = 1
            END IF
            CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &         IFOUND)
            IF (IFOUND .GT. 0) THEN
               CALL CHECK (I1, I2, N(20))
               DO 440 I = I1, I2
                  CALL LTSORT (MS, LINKS, I, IZ, ADDLNK)
  440          CONTINUE
               GO TO 430
            END IF
         ELSE
            CALL MESSAGE(' ')
            CALL MESSAGE('*----------------------------------*')
            CALL MESSAGE('* NO SIDES IN THE CURRENT DATABASE *')
            CALL MESSAGE('*----------------------------------*')
         END IF

C  DELETE BOUNDARY CONDITIONS

      ELSE IF ((CIN(ICOM)(1:1) .EQ. 'B') .OR.
     &   (CIN(ICOM)(1:1) .EQ. 'b')) THEN
         ICOM = ICOM + 1
         IF (ICOM .GT. JCOM) THEN
            CALL MESSAGE
     &         ('THE FOLLOWING BOUNDARY FLAG TYPES ARE AVAILABLE')
            CALL MESSAGE
     &         ('        P*OINT FLAGS    - FOR NODES AT POINTS')
            CALL MESSAGE
     &         ('        N*ODE FLAGS     - FOR NODES ON A BOUNDARY')
            CALL MESSAGE('        E*LEMENT FLAGS  - FOR ELEMENT SIDES '
     &         //'ON A BOUNDARY')
            CALL FREFLD (IZ, IZ, 'TYPE OF BOUNDARY FLAG TO BE '//
     &         'DELETED FROM: ', MCOM, IOSTAT, JCOM, KIN, CIN, IIN, RIN)
            ICOM = 1
         END IF
         IF ((CIN(ICOM)(1:1) .EQ. 'P') .OR.
     &      (CIN(ICOM)(1:1) .EQ. 'p')) THEN
            ICOM = ICOM + 1
            IF (N(11) .GT. 0) THEN
               CALL MESSAGE(' ')
               CALL MESSAGE('DELETE POINT BOUNDARY FLAGS <I1> '//
     &            'THROUGH <I2>:')
               CALL MESSAGE('HIT A RETURN TO END')
  450          CONTINUE
               IF (ICOM .GT. JCOM) THEN
                  CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN,
     &               CIN, IIN, RIN)
                  ICOM = 1
               END IF
               CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     1            IFOUND)
               IF (IFOUND .GT. 0) THEN
                  CALL CHECK (I1, I2, N(25))
                  DO 460 I = I1, I2
                     CALL LTSORT (MP, LINKPB, I, IZ, ADDLNK)
  460             CONTINUE
                  SIDEOK = .FALSE.
                  CALL LINKBC (MP, MS, 1, N(11), N(1), N(25), N(11),
     &               N(12), N(20), IPBF, IFPB, NPPF, LISTPB, NLPS,
     &               IFLINE, ILLIST, IPBOUN, LINKPB, IWTPBF, LINKP,
     &               LINKS, SIDEOK, NOROOM)
                  GO TO 450
               END IF
            ELSE
               CALL MESSAGE(' ')
               CALL MESSAGE
     &            ('*-----------------------------------------*')
               CALL MESSAGE
     &            ('* NO POINT BOUNDARY FLAGS IN THE DATABASE *')
               CALL MESSAGE
     &            ('*-----------------------------------------*')
               CALL MESSAGE(' ')
            END IF
         ELSE IF ((CIN(ICOM)(1:1) .EQ. 'N') .OR.
     &      (CIN(ICOM)(1:1) .EQ. 'n')) THEN
            ICOM = ICOM + 1
            IF (N(13) .GT. 0) THEN
               CALL MESSAGE(' ')
               CALL MESSAGE
     &            ('DELETE NODE BOUNDARY FLAGS <I1> THROUGH <I2>:')
               CALL MESSAGE('HIT A RETURN TO END')
  470          CONTINUE
               IF (ICOM .GT. JCOM) THEN
                  CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN,
     &               CIN, IIN, RIN)
                  ICOM = 1
               END IF
               CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &            IFOUND)
               IF (IFOUND .GT. 0) THEN
                  CALL CHECK (I1, I2, N(26))
                  DO 480 I = I1, I2
                     CALL LTSORT (ML, LINKLB, I, IZ, ADDLNK)
  480             CONTINUE

C  RELINK UP THE LINES TO THEIR ASSOCIATED FLAGS

                  SIDEOK = .TRUE.
                  CALL LINKBC (ML, MS, 1, N(13), N(2), N(26), N(13),
     &               N(14), N(20), ILBF, IFLB, NLPF, LISTLB, NLPS,
     &               IFLINE, ILLIST, ILBOUN, LINKLB, IWTLBF, LINKL,
     &               LINKS, SIDEOK, NOROOM)
                  GO TO 470
               END IF
            ELSE
               CALL MESSAGE(' ')
               CALL MESSAGE
     &            ('*----------------------------------------*')
               CALL MESSAGE
     &            ('* NO NODE BOUNDARY FLAGS IN THE DATABASE *')
               CALL MESSAGE
     &            ('*----------------------------------------*')
               CALL MESSAGE(' ')
            END IF
         ELSE IF ((CIN(ICOM)(1:1) .EQ. 'E') .OR.
     &      (CIN(ICOM)(1:1) .EQ. 'e')) THEN
            ICOM = ICOM + 1
            IF (N(15) .GT. 0) THEN
               CALL MESSAGE(' ')
               CALL MESSAGE
     &            ('DELETE ELEMENT BOUNDARY FLAGS <I1> THROUGH <I2>:')
               CALL MESSAGE('HIT A RETURN TO END')
  490          CONTINUE
               IF (ICOM .GT. JCOM) THEN
                  CALL FREFLD (IZ, IZ, '>', MCOM, IOSTAT, JCOM, KIN,
     &               CIN, IIN, RIN)
                  ICOM = 1
               END IF
               CALL GETI12 (MCOM, ICOM, JCOM, CIN, IIN, KIN, I1, I2,
     &            IFOUND)
               IF (IFOUND .GT. 0) THEN
                  CALL CHECK (I1, I2, N(27))
                  DO 500 I = I1, I2
                     CALL LTSORT (ML, LINKSB, I, IZ, ADDLNK)
  500             CONTINUE

C  RELINK UP THE LINES TO THEIR ASSOCIATED FLAGS

                  SIDEOK = .TRUE.
                  CALL LINKBC (ML, MS, 1, N(15), N(2), N(27), N(15),
     &               N(16), N(20), ISBF, IFSB, NSPF, LISTSB, NLPS,
     &               IFLINE, ILLIST, ISBOUN, LINKSB, IWTSBF, LINKL,
     &               LINKS, SIDEOK, NOROOM)
                  GO TO 490
               END IF
            ELSE
               CALL MESSAGE(' ')
               CALL MESSAGE
     &            ('*-------------------------------------------*')
               CALL MESSAGE
     &            ('* NO ELEMENT BOUNDARY FLAGS IN THE DATABASE *')
               CALL MESSAGE
     &            ('*-------------------------------------------*')
               CALL MESSAGE(' ')
            END IF
         END IF

C  EXIT OPTION - EXITS FASTQ

      ELSE IF ((CIN(ICOM)(1:2) .EQ. 'EX') .OR.
     &   (CIN(ICOM)(1:2) .EQ. 'ex')) THEN
         ICOM = ICOM + 1
         CALL STRLNG (CIN(ICOM), LEN)
         IF (((LEN .GT. 1) .AND. (CIN(ICOM)(2:2) .NE. 'X')) .OR.
     &      ((LEN .GT. 1) .AND. (CIN(ICOM)(2:2) .NE. 'x'))) THEN
            CALL HELP_FQ(6)
         ELSE
            CALL FEXIT (WROTE, MCOM, ICOM, JCOM, CIN, IIN, RIN, KIN,
     &         TIME1, BATCH, VERSN)
         ENDIF
         GO TO 100
      ELSE IF (CIN(ICOM)(1:1) .EQ. ' ') THEN
         ICOM = ICOM + 1
         RETURN

C  PRINT HELP MESSAGE

      ELSE
         ICOM = ICOM + 1
         CALL HELP_FQ(6)

      END IF
      GO TO 100

10000 FORMAT (' NO HOLES DEFINED IN REGION:', I6)
10010 FORMAT (' UNDEFINED REGION:', I6)
10020 FORMAT (' DEFLT: ', A72)
10040 FORMAT (1X, I5, 2X, A72)
10050 FORMAT (8X, A8)

      END
