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.
60 lines
1.6 KiB
60 lines
1.6 KiB
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 INATTR (MS, MR, MA, N17, N23, JJ, RIN, IFOUND, ATTRIB,
|
|
& LINKM, NOROOM)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE INATTR = INPUTS MATERIAL ATTRIBUTES INTO THE DATABASE
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION ATTRIB (MA, MR+MS), LINKM (2, (MS+MR))
|
|
|
|
LOGICAL NOROOM, ADDLNK
|
|
|
|
NOROOM = .TRUE.
|
|
ADDLNK = .FALSE.
|
|
|
|
C UPDATE THE COUNTER IF NEEDED
|
|
|
|
IF (JJ.GT.N23)N23 = JJ
|
|
|
|
C ADD THE ATTRIBUTES INTO THE DATABASE
|
|
|
|
N17 = N17 + 1
|
|
J = N17
|
|
IF (J .GT. (MS + MR))RETURN
|
|
CALL LTSORT (MS + MR, LINKM, JJ, IPNTR, ADDLNK)
|
|
ADDLNK = .TRUE.
|
|
IF (IPNTR .LE. 0)THEN
|
|
J = -J
|
|
MINUSJ = -J
|
|
CALL LTSORT (MS + MR, LINKM, JJ, MINUSJ, ADDLNK)
|
|
J = IABS (MINUSJ)
|
|
ELSE
|
|
CALL LTSORT (MS + MR, LINKM, JJ, J, ADDLNK)
|
|
ENDIF
|
|
IF (IFOUND .GT. MA)THEN
|
|
IEND = MA
|
|
WRITE (*, 10000)IFOUND, MA
|
|
ELSE
|
|
IEND = IFOUND
|
|
ENDIF
|
|
DO 100 I = 1, IEND
|
|
ATTRIB (J, I) = RIN (I)
|
|
100 CONTINUE
|
|
|
|
NOROOM = .FALSE.
|
|
|
|
RETURN
|
|
|
|
10000 FORMAT (' FOR MATERIAL NUMBER:', I5,
|
|
& ' NUMBER OF ATTRIBUTES READ:', I5, /,
|
|
& ' EXCEEDS MAX ALLOWED OF:',
|
|
& I5)
|
|
|
|
END
|
|
|