You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
134 lines
4.6 KiB
134 lines
4.6 KiB
2 years ago
|
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 CKELB (NELBLK, NUMEL, NUMNP, EBTYPE,
|
||
|
|
& IDELB, NUMELB, NUMLNK, NUMATR, LINK, ATRIB, ATNAME,
|
||
|
|
& NODUSE, MAPNO)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** CKELB *** (EXPLORE) Check database element blocks
|
||
|
|
C --
|
||
|
|
C --CKELB checks the element block information.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NELBLK - IN - the number of element blocks
|
||
|
|
C -- NUMEL - IN - the number of elements in all blocks
|
||
|
|
C -- NUMNP - IN - the number of nodes
|
||
|
|
C -- IDELB - IN - the element block ID for each block
|
||
|
|
C -- NUMELB - IN - the number of elements for each block
|
||
|
|
C -- NUMLNK - IN - the number of nodes per element for each block
|
||
|
|
C -- NUMATR - IN - the number of attributes for each block
|
||
|
|
C -- LINK - IN - the connectivity array
|
||
|
|
C -- ATRIB - IN - the attribute array
|
||
|
|
|
||
|
|
include 'exp_errcnt.blk'
|
||
|
|
include 'exodusII.inc'
|
||
|
|
INTEGER IDELB(*)
|
||
|
|
INTEGER NUMELB(*)
|
||
|
|
INTEGER NUMLNK(*)
|
||
|
|
INTEGER NUMATR(*)
|
||
|
|
INTEGER LINK(*)
|
||
|
|
REAL ATRIB(*)
|
||
|
|
INTEGER NODUSE(*)
|
||
|
|
INTEGER MAPNO(*)
|
||
|
|
CHARACTER*(MXSTLN) EBTYPE(*)
|
||
|
|
CHARACTER*(*) ATNAME(*)
|
||
|
|
|
||
|
|
CHARACTER*99 STRA
|
||
|
|
CHARACTER*99 STRB
|
||
|
|
|
||
|
|
if (numel .eq. 0 .and. nelblk .eq. 0) return
|
||
|
|
|
||
|
|
C --Check for unique identifier
|
||
|
|
|
||
|
|
DO 100 IELB = 1, NELBLK
|
||
|
|
IF (LOCINT (IDELB(IELB), IELB-1, IDELB) .GT. 0) THEN
|
||
|
|
CALL INTSTR (1, 0, IDELB(IELB), STRA, LSTRA)
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
& 'Element block ID ' // STRA(:LSTRA) // ' is not unique')
|
||
|
|
END IF
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
iatoff = 0
|
||
|
|
do ielb = 1, nelblk
|
||
|
|
do natr = 1, numatr(ielb)
|
||
|
|
if (atname(iatoff+natr)(1:1) .ne. ' ') then
|
||
|
|
do jatr = natr+1, numatr(ielb)
|
||
|
|
if (atname(iatoff+natr) .eq. atname(iatoff+jatr)) then
|
||
|
|
CALL INTSTR (1, 0, IDELB(IELB), STRA, LSTRA)
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
& 'Attribute name "'//
|
||
|
|
* ATNAME(iatoff+NATR)(:LENSTR(ATNAME(iatoff+NATR))) //
|
||
|
|
* '" in Element block ID ' // STRA(:LSTRA)
|
||
|
|
* // ' is not unique')
|
||
|
|
end if
|
||
|
|
end do
|
||
|
|
end if
|
||
|
|
end do
|
||
|
|
iatoff = iatoff + numatr(ielb)
|
||
|
|
end do
|
||
|
|
|
||
|
|
C --Check that the number of elements in element blocks is equal to the total
|
||
|
|
C --number of elements
|
||
|
|
|
||
|
|
NELB = INTADD (NELBLK, NUMELB)
|
||
|
|
IF (NELB .NE. NUMEL) THEN
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
* 'Sum of elements in all element blocks does not match total')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Check the connectivity for each element block
|
||
|
|
|
||
|
|
C .. Initialize noduse array to 0.
|
||
|
|
call iniint (numnp, 0, noduse)
|
||
|
|
|
||
|
|
IEL0 = 0
|
||
|
|
ISLNK = 1
|
||
|
|
DO 110 IELB = 1, NELBLK
|
||
|
|
if (ebtype(ielb) .eq. 'nsided' .or.
|
||
|
|
* ebtype(ielb) .eq. 'NSIDED') THEN
|
||
|
|
CALL CKEB1 (IEL0,
|
||
|
|
& IELB, IDELB(IELB), 1, NUMLNK(IELB), NUMNP,
|
||
|
|
& LINK(ISLNK), noduse)
|
||
|
|
ISLNK = ISLNK + NUMLNK(IELB)
|
||
|
|
else
|
||
|
|
CALL CKEB1 (IEL0,
|
||
|
|
& IELB, IDELB(IELB), NUMELB(IELB), NUMLNK(IELB), NUMNP,
|
||
|
|
& LINK(ISLNK), noduse)
|
||
|
|
ISLNK = ISLNK + NUMLNK(IELB) * NUMELB(IELB)
|
||
|
|
end if
|
||
|
|
IEL0 = IEL0 + NUMELB(IELB)
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
C ... Check whether all nodes have been specified in an elements connectivity.
|
||
|
|
nerr = 0
|
||
|
|
DO 120 I = 1, numnp
|
||
|
|
if (noduse(i) .ne. 1) then
|
||
|
|
if (nerr .lt. maxerrs .or. maxerrs .le. 0) then
|
||
|
|
CALL INTSTR (1, 0, I, STRA, LSTRA)
|
||
|
|
CALL INTSTR (1, 0, MAPNO(I), STRB, LSTRB)
|
||
|
|
CALL PRTERR ('CMDSPEC',
|
||
|
|
& 'Local Node ' // STRA(:LSTRA) //
|
||
|
|
$ ' (Global Node ' // STRB(:LSTRB) //
|
||
|
|
& ') is not connected to any elements')
|
||
|
|
else if (nerr .eq. maxerrs .and. maxerrs .gt. 0) then
|
||
|
|
call prterr('CMDSPEC',
|
||
|
|
$ '...skipping additional errors...'//
|
||
|
|
* ' (use command "maxerr #" to change)')
|
||
|
|
end if
|
||
|
|
nerr = nerr + 1
|
||
|
|
end if
|
||
|
|
120 continue
|
||
|
|
if (nerr .gt. 0) then
|
||
|
|
write (stra, 10020) nerr
|
||
|
|
call sqzstr(stra, lstra)
|
||
|
|
CALL PRTERR ('CMDSPEC', STRA(:lstra))
|
||
|
|
end if
|
||
|
|
10020 FORMAT('NODE USE ERROR: Found ',I12,
|
||
|
|
$ ' nodes that are not connected to any elements.')
|
||
|
|
RETURN
|
||
|
|
END
|