EXPLORE: Better error output for list/select

Author: gsjaardema

packages/seacas/applications/explore/exp_comand.f

@@ -375,7 +375,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
           if (FFMATC (IFLD, INTYP, CFIELD, 'NSET', 4) .OR.
      *      FFMATC (IFLD, INTYP, CFIELD, 'NODESET', 7)) THEN
             CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &        'nodal point set ID',
+     &        'nodal point set',
      &        NUMNPS, IDNPS, LISNPS(0), LISNPS(1), NSNAME, *270)
             if (lisnps(0) .gt. 0) then
               call selset(lisnp(0), lisnp(1),
@@ -386,7 +386,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
           else if (FFMATC (IFLD, INTYP, CFIELD, 'SSET', 4) .OR.
      *      FFMATC (IFLD, INTYP, CFIELD, 'SIDESET', 7)) THEN
             CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &        'side set ID',
+     &        'side set',
      &        NUMESS, IDESS, LISESS(0), LISESS(1), SSNAME, *270)
             if (lisess(0) .gt. 0) then
                CALL MDRSRV ('SCR',    KSCR,  NUMNP)
@@ -403,7 +403,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
             IF (NERR .GT. 0) GOTO 280
 
             CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &           'element block ID',
+     &           'element block',
      &           NELBLK, IDELB, IA(KLELB), IA(KLELB+1), EBNAME, *205)
  205        continue
             if (IA(KLELB) .gt. 0) then
@@ -441,7 +441,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
           if (FFMATC (IFLD, INTYP, CFIELD, 'SSET', 4) .OR.
      *      FFMATC (IFLD, INTYP, CFIELD, 'SIDESET', 7)) THEN
             CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &        'side set ID',
+     &        'side set',
      &        NUMESS, IDESS, LISESS(0), LISESS(1), SSNAME, *270)
             if (lisess(0) .gt. 0) then
               call selset(IA(KLEL), IA(KLEL+1),
@@ -476,7 +476,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
           IF (NERR .GT. 0) GOTO 280
 
           CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &         'element block ID',
+     &         'element block',
      &         NELBLK, IDELB, IA(KLELB), IA(KLELB+1), EBNAME, *220)
  220      CONTINUE
           CALL DBSELB (NELBLK, NUMEL, LENE, IA(KLELB),
@@ -490,7 +490,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
           CALL CKNONE (NUMNPS, .FALSE., 'nodal point sets', *270)
 
           CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &         'nodal point set ID',
+     &         'nodal point set',
      &         NUMNPS, IDNPS, LISNPS(0), LISNPS(1), NSNAME, *270)
 
         ELSE IF (LISTYP .EQ. 'SSETS') THEN
@@ -499,7 +499,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
           CALL CKNONE (NUMESS, .FALSE., 'element side sets', *270)
 
           CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
-     &         'element side set ID',
+     &         'element side set',
      &         NUMESS, IDESS, LISESS(0), LISESS(1), SSNAME, *270)
 
 C *** EXODUS Movement Commands ***

packages/seacas/applications/explore/exp_rixid.f

@@ -83,10 +83,17 @@ SUBROUTINE RIXID (INLINE, IFLD, INTYP, CFIELD, IFIELD,
                      goto 208
                   end if
                end do
-               call prterr('CMDERR',
-     $              'Could not find ' // SELMSG // ' ' // WORD)
+               ERRMSG = SELMSG // ' "' // WORD //
+     $              '" does not exist, ignored'
+               call sqzstr(errmsg, lstr)
+               call prterr('CMDERR', errmsg(:lstr))
                goto 110
  208           continue
+               IF (NUMSEL .GE. MAXSEL) THEN
+                  ERRMSG = 'Too many ' // SELMSG // 's selected'
+                  CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
+                  GOTO 120
+               END IF
                numsel = numsel + 1
                ixsel(numsel) = i
             ELSE
@@ -101,10 +108,9 @@ SUBROUTINE RIXID (INLINE, IFLD, INTYP, CFIELD, IFIELD,
 
                IF (IX .LE. 0) THEN
                   CALL INTSTR (1, 0, ID, WORD, LSTR)
-                  ERRMSG = SELMSG // ' ' //
-     &                 WORD(:LSTR) // ' does not exist, ignored'
-                  CALL PRTERR ('CMDERR', word(:lstr))
-
+                  write (*,*) 'WORD: ', WORD(:LSTR), ID
+                  CALL PRTERR ('CMDERR', SELMSG // ' ' //
+     &                 WORD(:LSTR) // ' does not exist, ignored')
                ELSE IF (LOCINT (IX, NUMSEL, IXSEL) .LE. 0) THEN
                   CALL FFADDI (ID, INLINE)
                   IF (NUMSEL .GE. MAXSEL) THEN

packages/seacas/libraries/suplib/intstr.f

@@ -29,17 +29,15 @@ SUBROUTINE INTSTR (NNUM, LNGSTR, INUM, ISTR, LSTR)
       INTEGER LSTR
 
       CHARACTER*20 SCISTR
-      CHARACTER*5 FFMT
+      CHARACTER*8 FFMT
 
       IF ((NNUM .EQ. 1) .AND. (LNGSTR .LE. 0)) THEN
 
 C      --Handle special case of single number, smallest length
 
-         WRITE (FFMT, 10000, IOSTAT=IDUM) LEN (ISTR(1))
-
+         WRITE (FFMT, 10000, IOSTAT=IDUM) LEN(ISTR(1))
          WRITE (ISTR(1), FFMT, IOSTAT=IDUM) INUM(1)
          CALL SQZSTR (ISTR(1), LSTR)
-
       ELSE
 
 C      --Determine smallest length of largest number string
@@ -66,7 +64,7 @@ SUBROUTINE INTSTR (NNUM, LNGSTR, INUM, ISTR, LSTR)
 C      --Convert all integers to string of given length
 
          WRITE (FFMT, 10000, IOSTAT=IDUM) LSTR
-10000     FORMAT ('(I', I2.2, ')')
+10000     FORMAT ('(I', I3.3, ')')
 
          DO 110 I = 1, NNUM
             WRITE (ISTR(I), FFMT, IOSTAT=IDUM) INUM(I)