C    Copyright(C) 1999-2021 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 CKESS (NUMESS, LESSEL, LESSNL, NUMEL, NUMNP,
     &   IDESS, NEESS, NNESS, IXEESS, IXNESS,
     &   LTEESS, LTSESS, FACESS, NSCR, ICHECK, RCHECK, NDIM,
     *   MAPEL, MAPND)
C=======================================================================

C   --*** CKESS *** (EXPLORE) Check database element side sets
C   --
C   --CKESS checks the element side set information.
C   --An error message is displayed if the end of file is read.
C   --
C   --Parameters:
C   --   NUMESS - IN - the number of element side sets
C   --   LESSEL - IN - the number of elements for all sets
C   --   LESSNL - IN - the number of nodes for all sets
C   --   NUMEL - IN - the number of elements
C   --   NUMNP - IN - the number of nodes
C   --   IDESS - IN - the element side set ID for each set
C   --   NEESS - IN - the number of elements for each set
C   --   NNESS - IN - the number of nodes for each set
C   --   IXEESS - IN - the index of the first element for each set
C   --   IXNESS - IN - the index of the first node for each set
C   --   LTEESS - IN - the elements for all sets
C   --   LTSESS - IN - the element faces for all sets
C   --   FACESS - IN - the distribution factors for all sets
C   --   NSCR - SCRATCH - size = LESSEL (not all used)
C   --   ICHECK - SCRATCH - size = MAX (NUMESS, LESSEL, LESSNL)
C   --   RCHECK - SCRATCH - size = NUMNP

      include 'exodusII.inc'
      INCLUDE 'exp_dbase.blk'

      INTEGER IDESS(*)
      INTEGER NEESS(*)
      INTEGER NNESS(*)
      INTEGER IXEESS(*)
      INTEGER IXNESS(*)
      INTEGER LTEESS(*)
      INTEGER LTSESS(*)
      REAL FACESS(*)
      INTEGER ICHECK(*)
      INTEGER NSCR(*)
      REAL RCHECK(*)
      INTEGER MAPEL(*)
      INTEGER MAPND(*)
      LOGICAL DIDHEAD, ALLSAM

      CHARACTER*1024 STRA

C   --Check for unique identifier

      DO 100 IESS = 1, NUMESS
         IF (LOCINT (IDESS(IESS), IESS-1, IDESS) .GT. 0) THEN
            CALL INTSTR (1, 0, IDESS(IESS), STRA, LSTRA)
            CALL PRTERR ('WARNING', 'Element side set ID '
     &         // STRA(:LSTRA) // ' is not unique')
         END IF
  100 CONTINUE

C   --Check number of elements in element side sets

      NESS = 0
      DO 110 IESS = 1, NUMESS
         NESS = MAX (NESS, IXEESS(IESS) + NEESS(IESS) - 1)
  110 CONTINUE

      IF (NESS .NE. LESSEL) THEN
         CALL PRTERR ('WARNING', 'Maximum element index'
     &      // ' in all element side sets does not match total')
      END IF

C   --Check all elements in element side sets are within element range

      CALL CHKRNG (LTEESS, LESSEL, NUMEL, NZERO, NERR)
      IF (NERR .GT. 0) THEN
         CALL PRTERR ('FATAL',
     &      'Element side set element ids are out of range')
      END IF
      IF (NZERO .GT. 0) THEN
         CALL PRTERR ('FATAL',
     &      'Element side set element ids are zero')
      END IF

C   --Check all element faces in element side sets are within range
C ... Since we don't know (or don't want to expend the effort...) the
C     the number of faces for each element, we assume that the maximum
C     number of faces is 4 for 2D and 6 for 3D
      CALL CHKRNG (LTSESS, LESSEL, 2*NDIM, NZERO, NERR)
      IF (NERR .GT. 0) THEN
        CALL PRTERR ('FATAL',
     &    'Element side set faces are out of range')
      END IF
      IF (NZERO .GT. 0) THEN
        CALL PRTERR ('FATAL',
     &    'Element side set faces are zero')
      END IF

C ... Check for duplicate element/sides in a sideset. This causes
C     problems with some analysis codes
      do iess = 1, numess
        call iniint(numel, 0, icheck)
        nel = neess(iess)
        indx = ixeess(iess)
        do j = 0, nel-1
          iel = lteess(indx+j)
          ifa = ltsess(indx+j)
          if (iel .gt. 0 .and. iel .le. numel) then
             if (btest(icheck(iel), ifa)) then
                write (stra, 10000) iel, ifa, idess(iess)
10000           FORMAT('SIDESET ERROR: The element face pair ',
     $               I12,'.',I1,
     $               ' is duplicated in sideset ', I12,'.')
                call sqzstr(stra, lstra)
                CALL PRTERR ('WARNING', STRA(:lstra))
             else
                icheck(iel) = ibset(icheck(iel), ifa)
             end if
          end if
        end do
      end do

c ... Check that the distribution factor count matches the number of nodes
C     in the sideset...
      do iess = 1, numess
        call exgsp(ndb, idess(iess), nsess, ndfss, ierr)
        if (nness(iess) .ne. ndfss .and. ndfss .gt. 0) then
           write (stra, 10002) idess(iess), ndfss, nness(iess)
10002      FORMAT('SIDESET ERROR: In sideset ', I12,
     *          ' the number of distribution factors (', I12,
     *          ') does not match the sideset node count (', I12, ')')
           call sqzstr(stra, lstra)
           CALL PRTERR ('WARNING', STRA(:lstra))
        end if
        if (ndfss .gt. 0) then
           call exgssc(ndb, idess(iess), nscr, ierr)
           numnod = 0
           do i = 1, neess(iess)
              numnod = numnod + nscr(i)
           end do
           if (ndfss .ne. numnod) then
              write (stra, 10001) idess(iess), ndfss, numnod
10001         FORMAT('SIDESET ERROR: In sideset ', I12,
     *             ' the number of distribution factors (', I12,
     *             ') does not match the computed sideset node count (',
     *             I12, ')')
              call sqzstr(stra, lstra)
              CALL PRTERR ('WARNING', STRA(:lstra))
           endif
        end if
      end do

c ... Check for discontinuous sideset distribution factors on a sideset.
C     That is, if node 42 on side 15 has a different df value than node 42 on side 11.
C     This is allowed for in exodus, but most users want a c1 continuous field defined.
      do iess = 1, numess
        call inirea(numnp, 0.0, rcheck)
        didhead = .false.
        IF (NNESS(IESS) .GT. 0) THEN
          IS = IXNESS(IESS)
          IE = IS + NNESS(IESS) - 1
C     ... See if all values are the same
          val = facess(is)
          allsam = .TRUE.
          do i=is+1, ie
            if (facess(i) .ne. val) then
              allsam = .FALSE.
              go to 90
            end if
          end do
 90       continue

          if (.not. allsam) then
C ... Get the number of df/nodes per face and the nodes on the face
C ... NOTE: facess is contiguous over all sidesets,
C           nscr is the number of nodes/df per face
C           icheck is the nodes for the faces.
            call exgssn(ndb, idess(iess), nscr, icheck, ierr)
            ISE = IXEESS(IESS)
            IEE = ISE + NEESS(IESS) - 1
            IDS = IS
            idf = 1
            idn = 1
            do i=ise, iee
              NDFPE = nscr(idf)
              idf=idf+1
              do j=1,ndfpe
                node = icheck(j+idn-1)
                if (rcheck(node) .ne. 0.0 .and.
     *            rcheck(node) .ne. facess(j+ids-1)) then
                  iel  = lteess(i)
                  isid = ltsess(i)
                  if (.not. didhead) then
                    WRITE (*, 10040, IOSTAT=IDUM) idess(iess)
                    didhead = .true.
                  end if
                  write (stra, 10050) mapel(iel), isid,
     *              mapnd(node), rcheck(node), facess(j+ids-1)
                  CALL PRTERR ('CMDSPEC', stra(:lenstr(stra)))
                else
                  rcheck(node) = facess(j+ids-1)
                endif
              end do
              ids = ids + ndfpe
              idn = idn + ndfpe
            end do
          end if
        END IF
      end do
10040 FORMAT('SIDESET DF CONTINUITY ERRORS For Sideset ',I12)
10050 FORMAT('Element ',I12,', Side ',I1, ', Node ',I12,
     *  ': Previous Value = ',1PE11.4,'  Current Value = ',1PE11.4)

      RETURN
      END
