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

      SUBROUTINE ROWSMO (MXND, MLN, XN, YN, ZN, LXK, KXL, NXL, LXN, NNN,
     &   WFAC, WFAC2, NIT, EPS, RO, NNN2, LNODES, BNSIZE, LLL, GRAPH,
     &   XMIN, XMAX, YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG)
C***********************************************************************

C  SUBROUTINE ROWSMO = SMOOTHS AN ADDED ROW DURING FILLING USING THE
C                      ISOPARAMETRIC SMOOTHER WITH SPECIAL CONSIDERATION
C                      GIVEN TO THE 2-LINE NODES (ROW CORNERS)

C***********************************************************************

C  VARIABLES USED:
C     WFAC = WEIGHT (0. = LAPLACIAN, 1. = ISOPARAMETRIC)
C     NIT  = THE MAX NUMBER OF ITERATIONS TO DO.
C     EPS  = MINIMUM DISTANCE NODES MUST MOVE TO CONTINUE ITERATIONS
C     RO   = AN UNDER- OR OVER-RELAXATION FACTOR (NORMALLY 1.0)

C***********************************************************************

      DIMENSION AREA(20)

      DIMENSION KLIST(20), NODES(4)
      DIMENSION XN(MXND), YN(MXND), ZN(MXND)
      DIMENSION LXN(4, MXND), NXL(2, 3*MXND)
      DIMENSION LXK(4, MXND), KXL(2, 3*MXND)
      DIMENSION LINES(20), LNODES (MLN, MXND), BNSIZE (2, MXND)

      LOGICAL BIG, CCW, ERR, GRAPH, NEAR2L, TEST, AVER

      CHARACTER*3 DEV1

      PI = ATAN2(0.0, -1.0)

      nodes(1) = -1
      nodes(2) = -1
      nodes(3) = -1
      nodes(4) = -1

      IF (RO .LT. 0.01) RO = 1.
      DRO = 1.0
      VRO = 1.0
      EPS2 = EPS * RO
      TEST = .FALSE.
      AVER = .TRUE.

C  ITERATION LOOP

      DO 160 IT = 1, NIT
         IF (IT .EQ. NIT) THEN
            CALL MESSAGE('THE ROWSMO ROUTINE IS NOT CONVERGING')
         ENDIF
         BIG = .FALSE.

C  NODE LOOP

         NBEGIN = MAX0 (NNN2 - 1, 1)
         NEND = NNN + 1
         DO 150 J = NBEGIN, NEND
            IF (J .EQ. NEND) THEN
               NODE = LNODES (3, NNN)
            ELSEIF (J .EQ. NBEGIN) THEN
               NODE = LNODES (2, NBEGIN)
            ELSE
               NODE = J
            ENDIF

C  SKIP CONTINUATION LINES, EXTERIOR BOUNDARY LINES, AND NODES
C  THAT ARE ON THE INTERIOR

            IF (NODE .gt. 0) THEN
            IF ((LXN(1, NODE) .GT. 0) .AND. (LXN(2, NODE) .GT. 0) .AND.
     &              (LNODES (4, NODE) .EQ. - 1))  THEN

C  FIND ELEMENTS AND LINES ATTACHED TO NODE

               CALL GKXN (MXND, KXL, LXN, NODE, KS, KLIST, ERR)
               CALL GETLXN (MXND, LXN, NODE, LINES, NL, ERR)

               SUMX = 0.0
               SUMY = 0.0

C  PERFORM AN AREA PULL AND LAPLACIAN
C  ON ANY NODE ATTACHED TO A 2-LINE NODE

C               TWOL = .FALSE.
C               NEAR2L = .FALSE.
C               IF (LXN (3, NODE) . EQ. 0) THEN
C                  TWOL = .TRUE.
C                  NFROM = 0
C               ELSE
C                  IF (NL .EQ. 3) THEN
C                     DO 100 IL = 1, NL
C                        ILL = LINES (IL)
C                        IF (NXL (1, ILL) .EQ. NODE) THEN
C                           NTEST = NXL (2, ILL)
C                        ELSEIF (NXL (2, ILL) .EQ. NODE) THEN
C                           NTEST = NXL (1, ILL)
C                        ELSE
C                           CALL MESSAGE('** PROBLEMS IN ROWSMO **')
C                           GOTO 110
C                        ENDIF
C                        NODES(IL) = NTEST
C                        IF (LXN (3, NTEST) .EQ. 0) THEN

C  MAKE SURE THAT THE OTHER END OF THE 2-LINE NODE HAS ONLY 3 LINES

C                           IF (LXN (1, NTEST) .EQ. ILL) THEN
C                              LTEST = LXN (2, NTEST)
C                           ELSEIF (LXN (2, NTEST) .EQ. ILL) THEN
C                              LTEST = LXN (1, NTEST)
C                           ELSE
C                              CALL MESSAGE('** PROBLEMS IN ROWSMO **')
C                              GOTO 110
C                           ENDIF
C                           IF (NXL (1, LTEST) .EQ. NTEST) THEN
C                              NTEST = NXL (2, LTEST)
C                           ELSEIF (NXL (2, LTEST) .EQ. NTEST) THEN
C                              NTEST = NXL (1, LTEST)
C                           ELSE
C                              CALL MESSAGE('** PROBLEMS IN ROWSMO **')
C                              GOTO 110
C                           ENDIF
C                           IF ((LXN (3, NTEST) .GT. 0) .AND.
C     &                        (LXN (4, NTEST) .EQ. 0)) THEN
C                              NEAR2L = .TRUE.
C                           ENDIF
C                        ENDIF
C  100                CONTINUE
C  110                CONTINUE
C                     NFROM = NODES(2)
C                  ELSE
C                     NFROM = 0
C                  ENDIF
C               ENDIF

               NEAR2L = .FALSE.
               IF ((NEAR2L) .OR. (TEST)) THEN
                  THETA1 = ATAN2 (YN (NODES (3)) - YN (NODES (1)),
     &               XN (NODES (3)) - XN (NODES (1)) ) + PI / 2.0
                  THETA2 = ATAN2 (YN (NODES (3)) - YN (NODES (2)),
     &               XN (NODES (3)) - XN (NODES (2)) ) + PI / 2.0
                  DET =  - COS (THETA1) * SIN (THETA2) + COS (THETA2) *
     &               SIN (THETA1)
                  X11 = 0.5 * (XN (NODES (1)) + XN (NODES (3)))
                  Y11 = 0.5 * (YN (NODES (1)) + YN (NODES (3)))
                  X21 = 0.5 * (XN (NODES (2)) + XN (NODES (3)))
                  Y21 = 0.5 * (YN (NODES (2)) + YN (NODES (3)))
                  R =  (- SIN (THETA2) * (X21 - X11) + COS (THETA2) *
     &               (Y21 - Y11)) / DET
                  XNEW = X11 + R * COS (THETA1)
                  YNEW = Y11 + R * SIN (THETA1)
                  XDEL = XNEW - XN (NODE)
                  YDEL = YNEW - YN (NODE)

C  PERFORM AN ISOPARAMETRIC SMOOTH ON OTHER NODES

               ELSE
                  DO 120 KL = 1, KS
                     CCW = .FALSE.
                     KK = KLIST(KL)
                     CALL GNXKA (MXND, XN, YN, KK, NODES, AREA(KL), LXK,
     &                  NXL, CCW)

                     DO 100 IN = 1, 4
                        IF (NODES(IN) .EQ. NODE) THEN
                           J1 = IN + 1
                           IF (J1 .GT. 4) J1 = 1
                           GO TO 110
                        END IF
  100                CONTINUE
  110                CONTINUE
                     J2 = J1 + 1
                     IF (J2 .GT. 4) J2 = 1
                     J3 = J2 + 1
                     IF (J3 .GT. 4) J3 = 1

                     SUMX = SUMX + XN(NODES(J1)) + XN(NODES(J3))
     &                  - WFAC * XN(NODES(J2))
                     SUMY = SUMY + YN(NODES(J1)) + YN(NODES(J3))
     &                  - WFAC * YN(NODES(J2))
  120             CONTINUE
                  SUMX = SUMX/(DBLE(KS) * (2.0 - WFAC))
                  SUMY = SUMY/(DBLE(KS) * (2.0 - WFAC))
                  XDEL = (RO * ( SUMX - XN (NODE) ))
                  YDEL = (RO * ( SUMY - YN (NODE) ))

                  CALL GETFRM (MXND, LINES, NL, NXL, NODE,
     &               LNODES (2, NODE), LNODES (3, NODE), NFROM)
                  IF (NFROM .GT. 0)
     &               THEN

C  FACTOR IN THE LENGTH CONSTANT (GENERATED LENGTH) OF THE NODE

                     DIST0 = BNSIZE (1,NODE) * BNSIZE (2,NODE)
                     XDIST = XDEL + XN (NODE) - XN (NFROM)
                     YDIST = YDEL + YN (NODE) - YN (NFROM)
                     DIST1 = SQRT (XDIST **2 + YDIST **2)
                     DFACT = (DIST0 / DIST1) * DRO
                     SUMX = XN (NFROM) + XDIST * DFACT
                     SUMY = YN (NFROM) + YDIST * DFACT
                     XDEL = SUMX - XN (NODE)
                     YDEL = SUMY - YN (NODE)

C  FACTOR IN THE EQUAL ANGLE VECTORS

                     IF (LNODES (2, NODE) .NE. LNODES (3, NODE)) THEN
                        CALL EQLANG (MXND, XN, YN, LXN, NODE,
     &                     LNODES (2, NODE), LNODES (3, NODE), NFROM,
     &                     DIST0, VRO, VX, VY)
                        IF (AVER) THEN
                           XDEL = (XDEL + VX) * .5
                           YDEL = (YDEL + VY) * .5
                        ELSE
                           XDEL = VX
                           YDEL = VY
                        ENDIF
                     ENDIF

                  ENDIF

               ENDIF

C  NOW CHECK THAT THE ROW IS NOT BENDING OVER ON ITSELF WITH THIS SMOOTH

               IF (LXN (4, NODE) .EQ. 0) CALL INVERT_FQ (MXND, MLN, XN,
     &            YN, ZN, LXK, KXL, NXL, LXN, LLL, LNODES, XMIN, XMAX,
     &            YMIN, YMAX, ZMIN, ZMAX, DEV1, KREG, NODE, XDEL, YDEL)

C  REDEFINE THIS NODE'S COORDINATES
C  AND PLOT THE NEW NODE AND LINES

               IF ((XDEL * XDEL + YDEL * YDEL) .GT. EPS2) BIG = .TRUE.
               IF (GRAPH) THEN
                  CALL LCOLOR ('BLACK')
                  DO 130 II = 1, NL
                     IDRAW = LINES(II)
                     NODE1 = NXL (1, IDRAW)
                     NODE2 = NXL (2, IDRAW)
                     CALL D2NODE (MXND, XN, YN, NODE1, NODE2)
  130             CONTINUE
                  CALL LCOLOR ('WHITE')
                  CALL SFLUSH
               ENDIF

               XN(NODE) = XN(NODE) + XDEL
               YN(NODE) = YN(NODE) + YDEL

               IF (GRAPH) THEN
                  DO 140 II = 1, NL
                     IDRAW = LINES(II)
                     NODE1 = NXL (1, IDRAW)
                     NODE2 = NXL (2, IDRAW)
                     CALL D2NODE (MXND, XN, YN, NODE1, NODE2)
  140             CONTINUE
                  CALL SFLUSH
               ENDIF

C  CHECK FOR CONVERGENCE

            ENDIF
            ENDIF
  150    CONTINUE

C  IF NO SIGNIFICANT MOVEMENTS OCCURRED,  RETURN

         IF (.NOT.BIG) RETURN
  160 CONTINUE

C  NOW SMOOTH THE INTERIOR

      RETURN
      END
