GJOIN: Fix nset sset name handling

tokusanya · Jul 16, 2024 · 64c4280 · 64c4280
1 parent 75e7dce
commit 64c4280
Show file tree

Hide file tree

Showing 4 changed files with 29 additions and 9 deletions.
diff --git a/packages/seacas/applications/gjoin/gj_muness.f b/packages/seacas/applications/gjoin/gj_muness.f
@@ -8,7 +8,8 @@
       SUBROUTINE MUNESS (NUMESS, ISTAT, LESSEL, LESSDL,
      &  IDESS, NEESS, NEDSS, IXEESS, IXEDSS,
      &  LTEESS, LTSSS, FACSS,
-     &  LTEX, LTSX, TDX, IXESS, IXDSS, NEX, NDX, ISCR, USESDF)
+     &  LTEX, LTSX, TDX, IXESS, IXDSS, NEX, NDX, ISCR, USESDF,
+     $  NAMES, NAMSC)
 C=======================================================================
 
 C   --*** MUNESS *** (GJOIN) Compress and rearrange element side sets
@@ -42,6 +43,8 @@ SUBROUTINE MUNESS (NUMESS, ISTAT, LESSEL, LESSDL,
 C   --   NDX - SCRATCH - size = NUMESS -- dist-face
 C   --   ISCR - SCRATCH - size = NUMESS
 
+      include 'gj_namlen.blk'
+
       INTEGER ISTAT(*)
       INTEGER IDESS(*)
       INTEGER NEESS(*), NEDSS(*)
@@ -53,6 +56,8 @@ SUBROUTINE MUNESS (NUMESS, ISTAT, LESSEL, LESSDL,
       INTEGER ISCR(*)
       REAL    FACSS(*), TDX(*)
       LOGICAL USESDF
+      character*(namlen) names(*)
+      character*(namlen) namsc(*)
 
       IF (NUMESS .LE. 0) RETURN
 
@@ -91,6 +96,7 @@ SUBROUTINE MUNESS (NUMESS, ISTAT, LESSEL, LESSDL,
   110 CONTINUE
 
       CALL ORDIX (JESS, IXESS, NUMESS, IDESS, ISCR, IDESS)
+      CALL ORDNAM (JESS, IXESS, NUMESS, NAMES, NAMSC, NAMES)
       CALL MOVINT (JESS, NEX, NEESS)
       CALL MOVINT (JESS, NDX, NEDSS)
       NUMESS = JESS

diff --git a/packages/seacas/applications/gjoin/gj_munnps.f b/packages/seacas/applications/gjoin/gj_munnps.f
@@ -7,7 +7,8 @@
 C=======================================================================
       SUBROUTINE MUNNPS (NUMNPS, ISTAT, LNPSNL,
      &   IDNPS, NNNPS, IXNNPS, LTNNPS, FACNPS,
-     &   LTNX, FACX, IXNPS, NNX, ISCR, NODSCR, NUMNP)
+     &   LTNX, FACX, IXNPS, NNX, ISCR, NODSCR,
+     $   NAMNS, NAMSC, NUMNP)
 C=======================================================================
 
 C   --*** MUNNPS *** (GJOIN) Compress and rearrange nodal point sets
@@ -36,6 +37,8 @@ SUBROUTINE MUNNPS (NUMNPS, ISTAT, LNPSNL,
 C   --   NUMNP - IN -- number of nodes in model
 C   --   NODSCR - SCRATCH - size = NUMNOD
 
+      include 'gj_namlen.blk'
+
       INTEGER ISTAT(*)
       INTEGER IDNPS(*)
       INTEGER NNNPS(*)
@@ -46,7 +49,9 @@ SUBROUTINE MUNNPS (NUMNPS, ISTAT, LNPSNL,
       INTEGER NNX(*)
       INTEGER ISCR(*)
       INTEGER NODSCR(*)
-
+      character*(namlen) namns(*)
+      character*(namlen) namsc(*)
+
       IF (NUMNPS .LE. 0) RETURN
 
       JNPS = 0
@@ -81,7 +86,7 @@ SUBROUTINE MUNNPS (NUMNPS, ISTAT, LNPSNL,
 
             NNEW = 0
             DO 100 I = 1, NNNPS(N)
-               IF (nodscr(ltnnps(inn0+i)) .eq. 0) then
+ 2             IF (nodscr(ltnnps(inn0+i)) .eq. 0) then
                   NNEW = NNEW + 1
                   LTNX(JNN0+NNEW) = LTNNPS(INN0+I)
                   FACX(JNN0+NNEW) = FACNPS(INN0+I)
@@ -93,6 +98,7 @@ SUBROUTINE MUNNPS (NUMNPS, ISTAT, LNPSNL,
   120 CONTINUE
 
       CALL ORDIX (JNPS, IXNPS, NUMNPS, IDNPS, ISCR, IDNPS)
+      CALL ORDNAM (JNPS, IXNPS, NUMNPS, NAMNS, NAMSC, NAMNS)
       CALL MOVINT (JNPS, NNX, NNNPS)
       NUMNPS = JNPS
       JNN = 1

diff --git a/packages/seacas/applications/gjoin/gj_qainfo.blk b/packages/seacas/applications/gjoin/gj_qainfo.blk
@@ -6,8 +6,8 @@ C    See packages/seacas/LICENSE for details
 
 C     -*- Mode: fortran -*-
       QAINFO(1) = 'GJoin2  '
-      QAINFO(2) = '2024/03/19                      '
-      QAINFO(3) = ' 1.41                           '
+      QAINFO(2) = '2024/05/29                      '
+      QAINFO(3) = ' 1.42                           '
 
 C - Added EXPXYZ - By material matching
 C - Fixes in expxyz, matxyz, comand, irennp
@@ -77,4 +77,5 @@ c - don't mclong if adding zero bytes
 c - remove warning about expxyz material matching routine
 c - fix name length issues
 c - fix parsing if no nodesets on models
-c - handle mirroring of tet10 models
+c - handle mirroring of tet10 models
+c - correct handling of nset and sset names
diff --git a/packages/seacas/applications/gjoin/gjoin.f b/packages/seacas/applications/gjoin/gjoin.f
@@ -551,20 +551,23 @@ PROGRAM GJOIN2
          CALL MDRSRV ('NNNPO',  KNNNO,  NEWNPS)
          CALL MDRSRV ('ISCR',   KISCR,  NEWNPS)
          call mdrsrv ('nodscr', kndscr, newnp)
+         CALL MCFIND ('NAMNS',  IDUM,   LNAM)
+         CALL MCRSRV ('NAMSCR', KNMSC,  LNAM)
          CALL MDSTAT (NERR, MEM)
          IF (NERR .GT. 0) GOTO 140
 
          CALL MUNNPS (NEWNPS, IA(KINPSS), NEWNNL,
      &      IA(KIDNS), IA(KNNNS), IA(KIXNNS), IA(KLTNNS), A(KFACNS),
      &      IA(KLTNNO), A(KFACNO), IA(KIXNNO), IA(KNNNO), IA(KISCR),
-     *      IA(KNDSCR), NEWNP)
+     *      IA(KNDSCR), C(KNMNS), C(KNMSC), NEWNP)
 
          CALL MDDEL ('LTNNPO')
          CALL MDDEL ('FACNPO')
          CALL MDDEL ('IXNNPO')
          CALL MDDEL ('NNNPO')
          CALL MDDEL ('ISCR')
          call mddel ('nodscr')
+         call mddel ('NAMSCR')
 
 C      --Squeeze the nodal point sets
 
@@ -597,14 +600,17 @@ PROGRAM GJOIN2
          CALL MDRSRV ('NEESO',  KNESO,  NEWESS)
          CALL MDRSRV ('NEDS0',  KNDS0,  NEWESS)
          CALL MDRSRV ('ISCR',   KISCR,  NEWESS)
+         CALL MCFIND ('NAMSS',  IDUM,   LNAM)
+         CALL MCRSRV ('NAMSCR', KNMSC,  LNAM)
          CALL MDSTAT (NERR, MEM)
          IF (NERR .GT. 0) GOTO 140
 
          CALL MUNESS (NEWESS, IA(KIESSS), NEWSEL, NEWSDL,
      &     IA(KIDSS), IA(KNESS), IA(KNDSS), IA(KIXESS), IA(KIXDSS),
      &     IA(KLTESS), IA(KLTSSS), A(KFACSS),
      &     IA(KLTESO), IA(KLTSSO), A(KFACS0), IA(KIXESO), IA(KIXDS0),
-     &     IA(KNESO), IA(KNDS0), IA(KISCR), USESDF)
+     &     IA(KNESO), IA(KNDS0), IA(KISCR), USESDF,
+     $     C(KNMSS), C(KNMSC))
 
          CALL MDDEL ('LTEESO')
          CALL MDDEL ('LTSSO')
@@ -614,6 +620,7 @@ PROGRAM GJOIN2
          CALL MDDEL ('NEESO')
          CALL MDDEL ('NEDS0')
          CALL MDDEL ('ISCR')
+         CALL MCDEL ('NAMSCR')
          CALL MDSTAT (NERR, MEM)
          IF (NERR .GT. 0) GOTO 140