Skip to content

Commit 954c64a

Browse files
gsjaardemagsjaardema
committed
EXPLORE: Allow name when listing/selecting sets/blocks
1 parent 7c7ffc2 commit 954c64a

File tree

3 files changed

+59
-45
lines changed

3 files changed

+59
-45
lines changed

‎packages/seacas/applications/explore/exp_comand.f‎

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
C Copyright(C) 1999-2020, 2023, 2024 National Technology & Engineering Solutions
1+
C Copyright(C) 1999-2020, 2023, 2024, 2025 National Technology & Engineering Solutions
22
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
33
C NTESS, the U.S. Government retains certain rights in this software.
44
C
@@ -376,7 +376,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
376376
* FFMATC (IFLD, INTYP, CFIELD, 'NODESET', 7)) THEN
377377
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
378378
& 'nodal point set ID',
379-
& NUMNPS, IDNPS, LISNPS(0), LISNPS(1), *270)
379+
& NUMNPS, IDNPS, LISNPS(0), LISNPS(1), NSNAME, *270)
380380
if (lisnps(0) .gt. 0) then
381381
call selset(lisnp(0), lisnp(1),
382382
* numnps, lisnps, lnpsnl,
@@ -387,7 +387,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
387387
* FFMATC (IFLD, INTYP, CFIELD, 'SIDESET', 7)) THEN
388388
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
389389
& 'side set ID',
390-
& NUMESS, IDESS, LISESS(0), LISESS(1), *270)
390+
& NUMESS, IDESS, LISESS(0), LISESS(1), SSNAME, *270)
391391
if (lisess(0) .gt. 0) then
392392
CALL MDRSRV ('SCR', KSCR, NUMNP)
393393
call selssetn(lisnp(0), lisnp(1),
@@ -403,8 +403,8 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
403403
IF (NERR .GT. 0) GOTO 280
404404

405405
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
406-
& 'element block ID',
407-
& NELBLK, IDELB, IA(KLELB), IA(KLELB+1), *205)
406+
& 'element block ID',
407+
& NELBLK, IDELB, IA(KLELB), IA(KLELB+1), EBNAME, *205)
408408
205 continue
409409
if (IA(KLELB) .gt. 0) then
410410
call selblk(lisnp(0), lisnp(1),
@@ -442,7 +442,7 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
442442
* FFMATC (IFLD, INTYP, CFIELD, 'SIDESET', 7)) THEN
443443
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
444444
& 'side set ID',
445-
& NUMESS, IDESS, LISESS(0), LISESS(1), *270)
445+
& NUMESS, IDESS, LISESS(0), LISESS(1), SSNAME, *270)
446446
if (lisess(0) .gt. 0) then
447447
call selset(IA(KLEL), IA(KLEL+1),
448448
* numess, lisess, lessel,
@@ -476,11 +476,10 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
476476
IF (NERR .GT. 0) GOTO 280
477477

478478
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
479-
& 'element block ID',
480-
& NELBLK, IDELB, IA(KLELB), IA(KLELB+1), *220)
479+
& 'element block ID',
480+
& NELBLK, IDELB, IA(KLELB), IA(KLELB+1), EBNAME, *220)
481481
220 CONTINUE
482-
483-
CALL DBSELB (NELBLK, NUMEL, LENE, A(KLELB),
482+
CALL DBSELB (NELBLK, NUMEL, LENE, IA(KLELB),
484483
& NLISEL, LISEL)
485484

486485
CALL MDDEL ('SCRSEL')
@@ -491,17 +490,17 @@ SUBROUTINE COMAND (A, IA, EXODUS, DBNAME, QAREC, INFO,
491490
CALL CKNONE (NUMNPS, .FALSE., 'nodal point sets', *270)
492491

493492
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
494-
& 'nodal point set ID',
495-
& NUMNPS, IDNPS, LISNPS(0), LISNPS(1), *270)
493+
& 'nodal point set ID',
494+
& NUMNPS, IDNPS, LISNPS(0), LISNPS(1), NSNAME, *270)
496495

497496
ELSE IF (LISTYP .EQ. 'SSETS') THEN
498497
NSTEPSS = -1
499498
IF (VERB .EQ. '*') VERB = 'LIST'
500499
CALL CKNONE (NUMESS, .FALSE., 'element side sets', *270)
501500

502501
CALL RIXID (DUMLIN, IFLD, INTYP, CFIELD, IFIELD,
503-
& 'element side set ID',
504-
& NUMESS, IDESS, LISESS(0), LISESS(1), *270)
502+
& 'element side set ID',
503+
& NUMESS, IDESS, LISESS(0), LISESS(1), SSNAME, *270)
505504

506505
C *** EXODUS Movement Commands ***
507506

‎packages/seacas/applications/explore/exp_qainfo.blk‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,8 @@ C See packages/seacas/LICENSE for details
88
QAINFO(2) = ' '
99
QAINFO(3) = ' '
1010

11-
QAINFO(2)(:8) = '20250806'
12-
QAINFO(3)(:8) = ' 4.06'
11+
QAINFO(2)(:8) = '20251001'
12+
QAINFO(3)(:8) = ' 4.07'
1313

1414
c..Dynamic dimensioning of block names+other changes
1515
c..compress output of distribution factors
@@ -80,3 +80,4 @@ c..Refactor element select to allow add
8080
c..Fix behavior after bad parse warning
8181
c..Minor support for change sets
8282
c..Improved bad map check / output
83+
c..allow names in list block/set

‎packages/seacas/applications/explore/exp_rixid.f‎

Lines changed: 43 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,11 @@
1-
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
1+
C Copyright(C) 1999-2020, 2025 National Technology & Engineering Solutions
22
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
33
C NTESS, the U.S. Government retains certain rights in this software.
44
C
55
C See packages/seacas/LICENSE for details
66
C=======================================================================
77
SUBROUTINE RIXID (INLINE, IFLD, INTYP, CFIELD, IFIELD,
8-
& SELMSG, MAXSEL, IDSEL, NUMSEL, IXSEL, *)
8+
& SELMSG, MAXSEL, IDSEL, NUMSEL, IXSEL, NAME, *)
99
C=======================================================================
1010

1111
C --*** RIXID *** (BLOT) Parse selection command
@@ -30,6 +30,8 @@ SUBROUTINE RIXID (INLINE, IFLD, INTYP, CFIELD, IFIELD,
3030
C -- * - return statement if error before any items selected
3131

3232
include 'exodusII.inc'
33+
INCLUDE 'exp_dbnums.blk'
34+
3335
CHARACTER*(*) INLINE
3436
INTEGER INTYP(*)
3537
CHARACTER*(*) CFIELD(*)
@@ -39,8 +41,9 @@ SUBROUTINE RIXID (INLINE, IFLD, INTYP, CFIELD, IFIELD,
3941
INTEGER IXSEL(*)
4042

4143
LOGICAL FFEXST, FFNUMB, FFMATC
42-
CHARACTER*80 ERRMSG
43-
CHARACTER*(MXNAME) WORD
44+
CHARACTER*1024 ERRMSG
45+
CHARACTER*(MXNAME) WORD, LCWORD
46+
CHARACTER*(NAMLEN) NAME(*)
4447

4548
IF (.NOT. (FFEXST (IFLD, INTYP))) THEN
4649

@@ -66,43 +69,54 @@ SUBROUTINE RIXID (INLINE, IFLD, INTYP, CFIELD, IFIELD,
6669
CALL FFADDC ('ADD', INLINE)
6770
ELSE
6871
NUMSEL = 0
69-
IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
70-
ERRMSG =
71-
& 'Expected "OFF" or "ADD" or ' // SELMSG // ' range'
72-
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
73-
GOTO 130
74-
END IF
7572
END IF
7673

7774
110 CONTINUE
7875
IF (FFEXST (IFLD, INTYP)) THEN
79-
76+
IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
77+
CALL FFCHAR (IFLD, INTYP, CFIELD,' ', WORD)
78+
call lowstr(LCWORD, WORD)
79+
WORD = LCWORD
80+
do i = 1, maxsel
81+
call lowstr(LCWORD, name(i))
82+
if (word .eq. LCWORD) then
83+
goto 208
84+
end if
85+
end do
86+
call prterr('CMDERR',
87+
$ 'Could not find ' // SELMSG // ' ' // WORD)
88+
goto 110
89+
208 continue
90+
numsel = numsel + 1
91+
ixsel(numsel) = i
92+
ELSE
8093
C --Scan ID
8194

82-
CALL FFINTG (IFLD, INTYP, IFIELD,
83-
& SELMSG, 0, ID, *120)
95+
CALL FFINTG (IFLD, INTYP, IFIELD,
96+
& SELMSG, 0, ID, *120)
8497

8598
C --Find and store the index of the ID
8699

87-
IX = LOCINT (ID, MAXSEL, IDSEL)
100+
IX = LOCINT (ID, MAXSEL, IDSEL)
88101

89-
IF (IX .LE. 0) THEN
90-
CALL INTSTR (1, 0, ID, WORD, LSTR)
91-
ERRMSG = SELMSG // ' ' //
92-
& WORD(:LSTR) // ' does not exist, ignored'
93-
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
102+
IF (IX .LE. 0) THEN
103+
CALL INTSTR (1, 0, ID, WORD, LSTR)
104+
ERRMSG = SELMSG // ' ' //
105+
& WORD(:LSTR) // ' does not exist, ignored'
106+
CALL PRTERR ('CMDERR', word(:lstr))
94107

95-
ELSE IF (LOCINT (IX, NUMSEL, IXSEL) .LE. 0) THEN
96-
CALL FFADDI (ID, INLINE)
97-
IF (NUMSEL .GE. MAXSEL) THEN
98-
ERRMSG = 'Too many ' // SELMSG // 's selected'
99-
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
100-
GOTO 120
101-
END IF
108+
ELSE IF (LOCINT (IX, NUMSEL, IXSEL) .LE. 0) THEN
109+
CALL FFADDI (ID, INLINE)
110+
IF (NUMSEL .GE. MAXSEL) THEN
111+
ERRMSG = 'Too many ' // SELMSG // 's selected'
112+
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
113+
GOTO 120
114+
END IF
102115

103-
NUMSEL = NUMSEL + 1
104-
IXSEL(NUMSEL) = IX
105-
END IF
116+
NUMSEL = NUMSEL + 1
117+
IXSEL(NUMSEL) = IX
118+
END IF
119+
end if
106120

107121
GOTO 110
108122
END IF

0 commit comments

Comments
 (0)