C Copyright(C) 2009-2017 National Technology & Engineering Solutions of
C 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 Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions are
C met:
C 
C     * Redistributions of source code must retain the above copyright
C       notice, this list of conditions and the following disclaimer.
C 
C     * Redistributions in binary form must reproduce the above
C       copyright notice, this list of conditions and the following
C       disclaimer in the documentation and/or other materials provided
C       with the distribution.
C     * Neither the name of NTESS nor the names of its
C       contributors may be used to endorse or promote products derived
C       from this software without specific prior written permission.
C 
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
C LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
C A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
C OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
C SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
C LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
C DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
C THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
C (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

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(*)

      INTEGER IX(3)

      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
