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.
168 lines
6.2 KiB
168 lines
6.2 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 PROCHS (A, IA, NELBLK, IDELB, IDSCR, NELB, NLNK, NATR,
|
||
|
|
& KLINKE, KATRIB, NAMELB, LPTR, ISHEX, HEXID, *)
|
||
|
|
C=======================================================================
|
||
|
|
C --PROCHS - PROCess HexShell elements
|
||
|
|
C --To visualize a HEXSHELL element the 12-noded HEXSHELL needs to
|
||
|
|
C --be separated into an 8-noded HEX and 4-node SHELL. A New element
|
||
|
|
C --block will be created for every element block that contains a
|
||
|
|
C --HEXSHELL element.
|
||
|
|
C --An error message is displayed if the end of file is read.
|
||
|
|
C --Parameters:
|
||
|
|
C -- IA - I/O - dynamic memory array for integer values
|
||
|
|
C -- A - I/O - dynamic memory array for real values
|
||
|
|
C -- C - I/0 - dynamic memory array for character values
|
||
|
|
C -- NELBLK - IN - number of element blocks
|
||
|
|
C -- IDELB - I/O - array: element block ids
|
||
|
|
C -- NELB - I/O - array: number of elements per element block
|
||
|
|
C -- NLNK - I/O - array: number of nodes per element
|
||
|
|
C -- NATR - I/O - array: number of attributes
|
||
|
|
C -- LINK - I/O - array: link array
|
||
|
|
C -- ATRIB - I/O - array: attribute array
|
||
|
|
C -- LPTR - IN - array: link pointer array
|
||
|
|
C -- ISHEX - IN - number of element blocks with hex shells
|
||
|
|
C -- KHEXID - IN - array storing HEXSHELL element block ids
|
||
|
|
|
||
|
|
DIMENSION A(*),IA(*)
|
||
|
|
INTEGER NELBLK
|
||
|
|
CHARACTER*(*) NAMELB(*)
|
||
|
|
INTEGER IDELB(*), IDSCR(*), NELB(*), NLNK(*), NATR(*)
|
||
|
|
INTEGER KLINKE, KATRIB
|
||
|
|
INTEGER LPTR(*)
|
||
|
|
INTEGER ISHEX, HEXID(*)
|
||
|
|
|
||
|
|
IHEX = 1
|
||
|
|
100 CONTINUE
|
||
|
|
IF (IHEX .GT. ISHEX) GO TO 200
|
||
|
|
C HEXSHELL element block ID - will remain HEX element block id
|
||
|
|
IDH = HEXID(IHEX)
|
||
|
|
C New element block ID for SHELL
|
||
|
|
IDS = IDH + 5000
|
||
|
|
C Sort the element block id array
|
||
|
|
DO 10 J = NELBLK+ISHEX, 1, -1
|
||
|
|
IF (IDELB(J) .EQ. IDH) THEN
|
||
|
|
C Element block id for shell element block
|
||
|
|
IDELB(J+1) = IDS
|
||
|
|
C Number of elements in shell element block
|
||
|
|
NELB(J+1) = NELB(J)
|
||
|
|
C Number of nodes per element for hex element block
|
||
|
|
NLNK(J) = 8
|
||
|
|
C Number of nodes per element for shell element block
|
||
|
|
NLNK(J+1) = 4
|
||
|
|
C Number of attributes in hex element block
|
||
|
|
NATR(J) = 0
|
||
|
|
C Number of attributes in shell element block
|
||
|
|
NATR(J+1) = 1
|
||
|
|
C Named type for hex element block
|
||
|
|
NAMELB(J) = 'HEX'
|
||
|
|
C Named type for shell element block
|
||
|
|
NAMELB(J+1)= 'SHELL'
|
||
|
|
C Process link array
|
||
|
|
C Pointer to LINK array for element block J
|
||
|
|
CALL GETPTR (IDH,NELBLK,IDSCR,LPTR,IPTR)
|
||
|
|
C Size of link array for HEXSHELL element block
|
||
|
|
NELEM = NELB(J)
|
||
|
|
C Reserve space for link array - HEX element block
|
||
|
|
CALL MDRSRV('HSCR', KHSCR, 8*NELEM)
|
||
|
|
C Reserve space for link array - SHELL element block
|
||
|
|
CALL MDRSRV('SSCR', KSSCR, 4*NELEM)
|
||
|
|
CALL MDSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) RETURN 1
|
||
|
|
CALL MODLNK(NELEM, IA(KHSCR), IA(KSSCR), IA(IPTR))
|
||
|
|
CALL MDDEL('HSCR')
|
||
|
|
CALL MDDEL('SSCR')
|
||
|
|
CALL MDSTAT (NERR, MEM)
|
||
|
|
IF (NERR .GT. 0) RETURN 1
|
||
|
|
GOTO 150
|
||
|
|
ELSE
|
||
|
|
IDELB(J) = IDELB(J-1)
|
||
|
|
NELB(J) = NELB(J-1)
|
||
|
|
NLNK(J) = NLNK(J-1)
|
||
|
|
NAMELB(J) = NAMELB(J-1)
|
||
|
|
ENDIF
|
||
|
|
10 CONTINUE
|
||
|
|
150 CONTINUE
|
||
|
|
IHEX = IHEX + 1
|
||
|
|
GO TO 100
|
||
|
|
200 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE GETPTR(ID, NELBLK, IDS, LPTR, IPTR)
|
||
|
|
C ID - IN - element block id of link array
|
||
|
|
C NELBLK - IN - number of element blocks
|
||
|
|
C IDS - IN - element blocks id of original elements
|
||
|
|
C LPTR - IN - 1st pointers in each element block for LINKE array
|
||
|
|
C IPTR - OUT - pointer into link array
|
||
|
|
|
||
|
|
INTEGER ID, NELBLK, IDS(*), LPTR(*)
|
||
|
|
|
||
|
|
C Search for element block id ID in IDS
|
||
|
|
DO 400 I = 1, NELBLK
|
||
|
|
IF (ID .EQ. IDS(I)) THEN
|
||
|
|
IPTR = LPTR(I)
|
||
|
|
GOTO 450
|
||
|
|
ENDIF
|
||
|
|
400 CONTINUE
|
||
|
|
450 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE MODLNK(NELEM, HEX, SHELL, LINKE)
|
||
|
|
C The LINKE array contains the connectivity for a 12 node HEXSHELL element.
|
||
|
|
C This subroutine will create a connectivity array for a HEX element block
|
||
|
|
C and a connectivity array for a SHELL element block. To create the
|
||
|
|
C HEX connectivity array the first 8 of 12 nodes from every element in
|
||
|
|
C the HEXSHELL element block connectivity are copied into the HEX(*)
|
||
|
|
C array (e.g. if the HEXSHELL element block has 2 elements, LINKE(1-8)
|
||
|
|
C and LINKE(13-20) are copied into the HEX array). The SHELL connectivity
|
||
|
|
C is created by copying nodes 9 through 12 from every element in the
|
||
|
|
C HEXSHELL element block connectivity into the SHELL connectivity
|
||
|
|
C (e.g. For 2 HEXSHELL elements, LINKE(9-12) and LINKE(21-24) will be
|
||
|
|
C copied into the SHELL connectivity). After the HEX and SHELL
|
||
|
|
C connectivity arrays have been created, they are copied back into
|
||
|
|
C the LINKE array. First HEX and then SHELL ares copied back into LINKE.
|
||
|
|
C C. Forsythe 7/31/97
|
||
|
|
|
||
|
|
INTEGER NELEM
|
||
|
|
INTEGER HEX(*), SHELL(*), LINKE(*)
|
||
|
|
INTEGER IH, IS
|
||
|
|
|
||
|
|
IH = 8*NELEM
|
||
|
|
IS = 4*NELEM
|
||
|
|
C Create HEX connectivity array - copy the first 8 of 12 nodes from
|
||
|
|
C every HEXSHELL element into the HEX connectivity array.
|
||
|
|
DO 300 I = 1, IH
|
||
|
|
INC = (I-1)/8
|
||
|
|
J = I + INC*4
|
||
|
|
HEX(I) = LINKE(J)
|
||
|
|
300 CONTINUE
|
||
|
|
|
||
|
|
C Create SHELL connectivity array - copy nodes 9-12 from every HEXSHELL
|
||
|
|
C element into the SHELL connectivity array.
|
||
|
|
DO 310 I = 1, IS
|
||
|
|
INC = (I-1)/4 + 1
|
||
|
|
J = I + INC*8
|
||
|
|
SHELL(I) = LINKE(J)
|
||
|
|
310 CONTINUE
|
||
|
|
|
||
|
|
C Copy the HEX and then the SHELL link arrays back into the LINKE array
|
||
|
|
DO 320 I = 1, IH
|
||
|
|
LINKE(I) = HEX(I)
|
||
|
|
320 CONTINUE
|
||
|
|
DO 330 I = 1, IS
|
||
|
|
J = IH + I
|
||
|
|
LINKE(J) = SHELL(I)
|
||
|
|
330 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|