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 C======================================================================= SUBROUTINE MSSTEP (A, ISTEP, NEWSET, NEWFAC, ANYDEF, ANYUND, & DOIXF, DON2B, DOELED, DOELEU, DODEAD, DONPS, DOESS, & LENF, NLNKF, LINKF, LENL, KLNSET, & KHIDEN, KHIDEF, KIXFAC, & KXN, KYN, KZN, KHZ, KVT, KPD, KDHZ, KDVT, KDPD, & KXF, KYF, KZF, KDXF, KDYF, KDZF, & NEWELB, IELBST, KN2ELB, KDN2B, IF2EL, KNPSUR) C======================================================================= C --*** MSSTEP *** (MESH) Compute coordinates, etc for time step C -- Written by Amy Gilkey - revised 05/26/88 C -- C --MSSTEP computes the values needed for the mesh plot of a particular C --time step. These values include the nodal deformed coordinates, C --the face coordinates (both deformed and undeformed), and C --the line set. The memory for these values is expanded if needed. C --The values which do not change between time steps (e.g., the C --undeformed coordinates are not recalculated. C -- C --This routine uses MDFIND to find the following dynamic memory arrays: C -- IF2EL2 - the secondary element number of each face C -- IE2ELB - the element block for each element C -- C --Parameters: C -- A - IN - the dynamic memory base array C -- ISTEP - IN - the time step number C -- NEWSET - IN - true iff start of a new plot set C -- NEWFAC - IN - true iff the faces have changed C -- ANYDEF - IN - true iff any deformed mesh is to be plotted C -- ANYUND - IN - true iff any undeformed mesh is to be plotted C -- DOIXF - IN - true iff the IXFAC array is needed C -- DON2B - IN - true iff the IN2ELB array is needed C -- DOELED - IN - true iff the deformed element quarilateral centers C -- are needed C -- DOELEU - IN - true iff the undeformed element quarilateral centers C -- are needed C -- DODEAD - IN - true iff dead nodes are needed C -- DONPS - IN - true iff node set information is needed C -- DOESS - IN - true iff side set information is needed C -- LENF - IN/OUT - the cumulative face counts by element block C -- NLNKF - IN - the number of nodes per face C -- LINKF - IN/OUT - the connectivity for all faces C -- LENL - IN/OUT - the cumulative line counts by element block C -- KLNSET - IN/OUT - the dynamic memory index of the sorted line set C -- KHIDEN - OUT - the index of HIDENP - sized only C -- KHIDEF - OUT - the index of HIDEF - sized only C -- KIXFAC - OUT - the index of IXFAC - sized only C -- KXN, KYN, KZN - IN/OUT - the indices of XN, YN, ZN - C -- the nodal coordinates (ZN for 3D only) C -- KHZ, KVT, KPD - IN/OUT - the indices of HZ, VT, PD - C -- the undeformed nodal coordinates C -- (rotated for 3D, PD for 3D only) C -- KDHZ, KDVT, KDPD - IN/OUT - the indices of DHZ, DVT, DPD - C -- the deformed nodal coordinates C -- (rotated for 3D, DPD for 3D only) C -- KXF, KYF, KZF - IN/OUT - the indices of XF, YF, ZF - C -- the element face center coordinates C -- (rotated for 3D, ZF for 3D only) C -- KDXF, KDYF, KDZF - IN/OUT - the indices of DXF, DYF, DZF - C -- the deformed face center coordinates C -- (rotated for 3D, DZF for 3D only) C -- NEWELB - IN/OUT - the new element blocks flag: C -- 0 = no new element blocks C -- 1 = new selected element blocks C -- 2 = new displayed element blocks (implies new selected blocks) C -- IELBST - IN/OUT - the element block status: C -- -1 = OFF, 0 = ON, but not selected, 1 = selected C -- KN2ELB - IN/OUT - the index of IN2ELB - C - the element block for each node; C -- <0 if not in any selected element block C -- =0 if in more than one selected element block C -- KDN2B - IN/OUT - the index of IDN2B - C -- the element block for each dead node; dead if >= 0 C -- IF2EL - IN - the element number of each face C -- KNPSUR - IN/OUT - the index of NPSURF - C -- the node numbers of the surface nodes or mesh boundary nodes (2D) C -- C --Common Variables: C -- Uses NDIM, NELBLK of /DBNUMS/ C -- Uses IS3DIM, NNPSUR, NUMNPF, LLNSET of /D3NUMS/ C -- Uses DEFPRO, DEFOK, DFAC of /DEFORM/ C -- Uses ROTMAT, ROTCEN of /ROTOPT/ include 'dbnums.blk' COMMON /D3NUMS/ IS3DIM, NNPSUR, NUMNPF, LLNSET LOGICAL IS3DIM COMMON /DEFORM/ DEFPRO, DEFOK, DEFFAC, DDFAC, DFAC, & IXDEF, IYDEF, IZDEF LOGICAL DEFPRO, DEFOK COMMON /ROTOPT/ NEWROT, ROTMAT(3,3), ROTCEN(3), EYE(3) LOGICAL NEWROT COMMON /SIZES/ NPSIZ C --NPSIZ - the size of the nodal coordinate arrays passed to the C -- HIDDEN routine for partial line DIMENSION A(*) LOGICAL NEWSET, NEWFAC LOGICAL ANYDEF, ANYUND LOGICAL DOIXF, DON2B, DOELED, DOELEU, DODEAD, DONPS, DOESS INTEGER LENF(0:NELBLK+4) INTEGER NLNKF(NELBLK) INTEGER LINKF(*) INTEGER LENL(-2:NELBLK) INTEGER NEWELB INTEGER IELBST(NELBLK) INTEGER IF2EL(*) LOGICAL NEWNPD, NEWNPU, NEWELD, NEWELU SAVE NEWNPU, NEWELU DATA NEWNPU, NEWELU / .TRUE., .TRUE. / IF (NEWFAC) THEN C --Force the re-calculation of connected element count, if needed NEWELB = 1 C --Force the re-calculation of undeformed nodal and face coordinates NEWNPU = .TRUE. NEWELU = .TRUE. C --Set size of deformed coordinate arrays for hidden line algorithm NPSIZ = NUMNPF IF (IS3DIM) NPSIZ = (13 * NUMNPF) / 10 END IF C --Force the re-calculation of deformed nodal and face coordinates NEWNPD = DEFOK .AND. DEFPRO NEWELD = DEFOK .AND. DEFPRO C --Force the re-calculation of undeformed nodal and face coordinates IF (NEWROT .OR. NEWSET) THEN NEWNPU = .TRUE. NEWELU = .TRUE. END IF C --Release memory that will vary in size or not be needed IF (NEWSET .OR. NEWFAC) THEN IF (NEWELB .GE. 1) THEN CALL MDLONG ('IN2ELB', KN2ELB, 0) END IF IF (DODEAD) CALL MDLONG ('IDN2B', KDN2B, 0) END IF IF (NNPSUR .LT. 0) THEN CALL MDLONG ('NPSURF', KNPSUR, 0) END IF IF (IS3DIM .AND. NEWNPU) THEN CALL MDLONG ('HZ', KHZ, 0) CALL MDLONG ('VT', KVT, 0) IF (IS3DIM) CALL MDLONG ('PD', KPD, 0) END IF IF (NEWNPD) THEN CALL MDLONG ('DHZ', KDHZ, 0) CALL MDLONG ('DVT', KDVT, 0) IF (IS3DIM) CALL MDLONG ('DPD', KDPD, 0) END IF IF (NEWELU) THEN CALL MDLONG ('XF', KXF, 0) CALL MDLONG ('YF', KYF, 0) IF (IS3DIM) CALL MDLONG ('ZF', KZF, 0) END IF IF (NEWELD) THEN CALL MDLONG ('DXF', KDXF, 0) CALL MDLONG ('DYF', KDYF, 0) IF (IS3DIM) CALL MDLONG ('DZF', KDZF, 0) END IF IF (IS3DIM .AND. NEWFAC) THEN CALL MDLONG ('HIDENP', KHIDEN, 0) CALL MDLONG ('HIDEF', KHIDEF, 0) IF (DOIXF) CALL MDLONG ('IXFAC', KIXFAC, 0) END IF CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 C --Compute new line set if new faces IF (NEWFAC) THEN CALL MSLINS (A, LENF, NLNKF, LINKF, IF2EL, LENL, KLNSET) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 END IF C --Compute node to element block and dead node to element block, C --if needed IF ((NEWELB .GE. 1) .AND. (DON2B .OR. DONPS .OR. DOESS)) THEN IF (NEWSET .OR. NEWFAC) THEN CALL MDLONG ('IN2ELB', KN2ELB, NUMNPF) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 END IF CALL MAKN2B (LENF, NLNKF, LINKF, IELBST, A(KN2ELB)) NEWELB = 0 END IF IF (DODEAD) THEN IF (NEWSET .OR. NEWFAC) THEN CALL MDLONG ('IDN2B', KDN2B, NUMNPF) END IF IF (IS3DIM) THEN CALL MDFIND ('IF2EL2', KIF2E2, IDUM) ELSE KIF2E2 = 1 KE2ELB = 1 END IF CALL MDFIND ('IE2ELB', KE2ELB, IDUM) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 CALL MAKD2B (LENF, NLNKF, LINKF, IELBST, & IF2EL, A(KIF2E2), A(KE2ELB), A(KDN2B)) END IF C --Compute NPSURF nodes for 3D, if changed IF (NNPSUR .LT. 0) THEN CALL MDLONG ('NPSURF', KNPSUR, NUMNPF) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 CALL MAKSUR (LENF, NLNKF, LINKF, & DODEAD, A(KDN2B), A(KNPSUR)) CALL MDLONG ('NPSURF', KNPSUR, NNPSUR) END IF C --Put rotated undeformed coordinates in undeformed arrays, if needed IF (NEWNPU .AND. ANYUND) THEN IF (IS3DIM) THEN CALL MDLONG ('HZ', KHZ, NPSIZ) CALL MDLONG ('VT', KVT, NPSIZ) IF (IS3DIM) CALL MDLONG ('PD', KPD, NPSIZ) ELSE KHZ = KXN KVT = KYN KPD = KZN END IF IF (IS3DIM) THEN CALL BL_ROTATE (NNPSUR, A(KNPSUR), ROTMAT, ROTCEN, & A(KXN), A(KYN), A(KZN), A(KHZ), A(KVT), A(KPD)) C --Force the re-calculation of undeformed face coordinates NEWELU = .TRUE. END IF NEWNPU = .FALSE. NEWROT = .FALSE. END IF C --Compute deformed nodal coordinates, if needed IF (NEWNPD .AND. ANYDEF) THEN CALL MDLONG ('DHZ', KDHZ, NPSIZ) CALL MDLONG ('DVT', KDVT, NPSIZ) IF (IS3DIM) CALL MDLONG ('DPD', KDPD, NPSIZ) CALL DEFXYZ (A, ISTEP, DFAC, IS3DIM, A(KNPSUR), & A(KXN), A(KYN), A(KZN), A(KDHZ), A(KDVT), A(KDPD)) IF (IS3DIM) THEN CALL BL_ROTATE (NNPSUR, A(KNPSUR), ROTMAT, ROTCEN, & A(KDHZ), A(KDVT), A(KDPD), A(KDHZ), A(KDVT), A(KDPD)) END IF C --Force the re-calculation of deformed face coordinates NEWELD = .TRUE. NEWNPU = .FALSE. END IF C --Get face coordinates, if changed IF (NEWELU .AND. DOELEU) THEN IF (NEWELU) THEN CALL MDLONG ('XF', KXF, LENF(NELBLK)) CALL MDLONG ('YF', KYF, LENF(NELBLK)) IF (IS3DIM) CALL MDLONG ('ZF', KZF, LENF(NELBLK)) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 END IF CALL ELECOR (NDIM, NELBLK, LENF, NLNKF, LINKF, & A(KHZ), A(KVT), A(KPD), A(KXF), A(KYF), A(KZF)) NEWELU = .FALSE. END IF IF (NEWELD .AND. DOELED) THEN IF (NEWELD) THEN CALL MDLONG ('DXF', KDXF, LENF(NELBLK)) CALL MDLONG ('DYF', KDYF, LENF(NELBLK)) IF (IS3DIM) CALL MDLONG ('DZF', KDZF, LENF(NELBLK)) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 END IF CALL ELECOR (NDIM, NELBLK, LENF, NLNKF, LINKF, & A(KDHZ), A(KDVT), A(KDPD), A(KDXF), A(KDYF), A(KDZF)) NEWELD = .FALSE. END IF IF (IS3DIM .AND. NEWFAC) THEN CALL MDLONG ('HIDENP', KHIDEN, NUMNPF) CALL MDLONG ('HIDEF', KHIDEF, LENF(NELBLK)) IF (DOIXF) CALL MDLONG ('IXFAC', KIXFAC, LENF(NELBLK)) CALL MDSTAT (NERR, MEM) IF (NERR .GT. 0) GOTO 100 END IF 100 CONTINUE RETURN END