From 64c4280c8c552beb08bb5cf3ff6af8039e137194 Mon Sep 17 00:00:00 2001 From: Greg Sjaardema Date: Wed, 29 May 2024 16:04:38 -0600 Subject: [PATCH] GJOIN: Fix nset sset name handling --- packages/seacas/applications/gjoin/gj_muness.f | 8 +++++++- packages/seacas/applications/gjoin/gj_munnps.f | 12 +++++++++--- packages/seacas/applications/gjoin/gj_qainfo.blk | 7 ++++--- packages/seacas/applications/gjoin/gjoin.f | 11 +++++++++-- 4 files changed, 29 insertions(+), 9 deletions(-) diff --git a/packages/seacas/applications/gjoin/gj_muness.f b/packages/seacas/applications/gjoin/gj_muness.f index f73f1c6f0e..ed71e0bab1 100644 --- 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 index 8b63fc73d9..42db35fd46 100644 --- 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 index f907641f6b..8dc80eb185 100644 --- 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 \ No newline at end of file +c - handle mirroring of tet10 models +c - correct handling of nset and sset names \ No newline at end of file diff --git a/packages/seacas/applications/gjoin/gjoin.f b/packages/seacas/applications/gjoin/gjoin.f index 64b240b060..5be91707b7 100644 --- a/packages/seacas/applications/gjoin/gjoin.f +++ b/packages/seacas/applications/gjoin/gjoin.f @@ -551,13 +551,15 @@ 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') @@ -565,6 +567,7 @@ PROGRAM GJOIN2 CALL MDDEL ('NNNPO') CALL MDDEL ('ISCR') call mddel ('nodscr') + call mddel ('NAMSCR') C --Squeeze the nodal point sets @@ -597,6 +600,8 @@ 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 @@ -604,7 +609,8 @@ PROGRAM GJOIN2 & 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