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.
72 lines
2.4 KiB
72 lines
2.4 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 CKNPS (NUMNPS, LNPSNL, NUMNP,
|
||
|
|
& IDNPS, NNNPS, IXNNPS, LTNNPS, FACNPS, ICHECK)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** CKNPS *** (EXPLORE) Check database nodal point sets
|
||
|
|
C --
|
||
|
|
C --CKNPS checks the nodal point set information.
|
||
|
|
C --An error message is displayed if the end of file is read.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- NUMNPS - IN - the number of nodal point sets
|
||
|
|
C -- LNPSNL - IN - the number of nodes for all sets
|
||
|
|
C -- NUMNP - IN - the number of nodes
|
||
|
|
C -- IDNPS - IN - the nodal point set ID for each set
|
||
|
|
C -- NNNPS - IN - the number of nodes for each set
|
||
|
|
C -- IXNNPS - IN - the index of the first node for each set
|
||
|
|
C -- LTNNPS - IN - the nodes for all sets
|
||
|
|
C -- FACNPS - IN - the distribution factors for all sets
|
||
|
|
C -- ICHECK - SCRATCH - size = MAX (NUMNPS, LNPSNL)
|
||
|
|
|
||
|
|
INTEGER IDNPS(*)
|
||
|
|
INTEGER NNNPS(*)
|
||
|
|
INTEGER IXNNPS(*)
|
||
|
|
INTEGER LTNNPS(*)
|
||
|
|
REAL FACNPS(*)
|
||
|
|
INTEGER ICHECK(*)
|
||
|
|
|
||
|
|
CHARACTER*5 STRA
|
||
|
|
|
||
|
|
C --Check for unique identifier
|
||
|
|
|
||
|
|
DO 100 INPS = 1, NUMNPS
|
||
|
|
IF (LOCINT (IDNPS(INPS), INPS-1, IDNPS) .GT. 0) THEN
|
||
|
|
CALL INTSTR (1, 0, IDNPS(INPS), STRA, LSTRA)
|
||
|
|
CALL PRTERR ('CMDSPEC', 'Nodal point set ID '
|
||
|
|
& // STRA(:LSTRA) // ' is not unique')
|
||
|
|
END IF
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
C --Check number of nodes in nodal point sets
|
||
|
|
|
||
|
|
NNPS = 0
|
||
|
|
DO 110 INPS = 1, NUMNPS
|
||
|
|
NNPS = MAX (NNPS, IXNNPS(INPS) + NNNPS(INPS) - 1)
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
IF (NNPS .NE. LNPSNL) THEN
|
||
|
|
CALL PRTERR ('WARNING', 'Maximum node index' //
|
||
|
|
& ' in all nodal point sets does not match total')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Check all nodes in node point sets are within node range
|
||
|
|
|
||
|
|
CALL CHKRNG (LTNNPS, LNPSNL, NUMNP, NZERO, NERR)
|
||
|
|
IF (NERR .GT. 0) THEN
|
||
|
|
CALL PRTERR ('FATAL',
|
||
|
|
& 'Nodal point set node ids are out of range')
|
||
|
|
END IF
|
||
|
|
IF (NZERO .GT. 0) THEN
|
||
|
|
CALL PRTERR ('FATAL',
|
||
|
|
& 'Nodal point set node ids are zero')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|