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.
209 lines
6.7 KiB
209 lines
6.7 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
|
|
|
|
C=======================================================================
|
|
SUBROUTINE WRELB (A, IA, BLKTYP, NAMELB, IBPARM,
|
|
& IDELB, NUMELB, NUMLNK, NUMATR, LINK, ATRIB, ELATTR,
|
|
& IXEL, INCEL, NREL, IELCOL, IXNP, NRNP, NUMELB3)
|
|
C=======================================================================
|
|
|
|
C --*** WRELB *** (GEN3D) Write 3D element blocks
|
|
C -- Written by Amy Gilkey - revised 09/02/87
|
|
C --
|
|
C --WRELB calculates and writes the element block information for the
|
|
C --3D database.
|
|
C --Some dynamic dimensioning is done.
|
|
C --
|
|
C --Parameters:
|
|
C -- A - IN/OUT - the dynamic memory base array
|
|
C -- BLKTYP - IN - the element block type
|
|
C -- IBPARM - IN - the block parameters (defined by the block type)
|
|
C -- IDELB - IN - the 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 2D connectivity array (always 4 nodes)
|
|
C -- ATRIB - IN - the 2D attribute array (packed)
|
|
C -- IXEL - IN - the new index for each element
|
|
C -- INCEL - IN - the increment for each element, needed for blocks
|
|
C -- that become multiple blocks
|
|
C -- NREL - IN - the number of new elements generated for each element
|
|
C -- IELCOL - IN - the row number for each element, 0 if not needed
|
|
C -- IXNP - IN - the new index for each node
|
|
C -- NRNP - IN - the number of new nodes generated for each node
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NDBOUT of /DBASE/
|
|
C -- Uses NUMEL, NELBLK of /DBNUMS/
|
|
C -- Uses NUMEL3 of /DBNUM3/
|
|
C -- Uses NEREPL of /PARAMS/
|
|
|
|
INCLUDE 'exodusII.inc'
|
|
INCLUDE 'g3_dbase.blk'
|
|
INCLUDE 'g3_dbnums.blk'
|
|
INCLUDE 'g3_dbnum3.blk'
|
|
INCLUDE 'g3_params.blk'
|
|
INCLUDE 'g3_xyzmir.blk'
|
|
|
|
REAL A(*)
|
|
INTEGER IA(*)
|
|
CHARACTER BLKTYP(NELBLK)
|
|
CHARACTER*(MXSTLN) NAMELB(NELBLK)
|
|
INTEGER IBPARM(4,NELBLK)
|
|
INTEGER IDELB(NELBLK)
|
|
INTEGER NUMELB(NELBLK)
|
|
INTEGER NUMELB3(NELBLK)
|
|
INTEGER NUMLNK(NELBLK)
|
|
INTEGER NUMATR(NELBLK)
|
|
INTEGER LINK(4,*)
|
|
REAL ATRIB(*)
|
|
REAL ELATTR(*)
|
|
INTEGER IXEL(*), INCEL(*), NREL(*), IELCOL(*)
|
|
INTEGER IXNP(*), NRNP(*)
|
|
|
|
C ... Update block names
|
|
DO I = 1, NELBLK
|
|
IF (NAMELB(I)(:4) .EQ. 'QUAD' .OR.
|
|
* NAMELB(I)(:4) .EQ. 'quad' .OR.
|
|
* NAMELB(I) .EQ. ' ') then
|
|
NAMELB(I) = 'HEX'
|
|
else IF (NAMELB(I)(:3) .EQ. 'BAR' .OR.
|
|
* NAMELB(I)(:3) .EQ. 'bar' .OR.
|
|
* NAMELB(I)(:5) .EQ. 'TRUSS'.OR.
|
|
* NAMELB(I)(:5) .EQ. 'truss'.OR.
|
|
* NAMELB(I)(:4) .EQ. 'BEAM' .OR.
|
|
* NAMELB(I)(:4) .EQ. 'beam') then
|
|
NAMELB(I) = 'SHELL'
|
|
else if (NAMELB(I)(:3) .EQ. 'TRI') then
|
|
NAMELB(I) = 'WEDGE'
|
|
end if
|
|
end do
|
|
|
|
MAXID = 0
|
|
MAXEL = 0
|
|
MAXATR = 0
|
|
DO IELB = 1, NELBLK
|
|
MAXID = MAX (MAXID, IDELB(IELB))
|
|
MAXEL = MAX (MAXEL, NUMELB(IELB))
|
|
MAXATR = MAX (MAXATR, NUMATR(IELB))
|
|
end do
|
|
CALL MDRSRV ('LINK3', KLINK3, 8 * MAXEL*NEREPL)
|
|
CALL MDRSRV ('ATRIB3', KATR3, MAXATR * MAXEL*NEREPL)
|
|
CALL MDSTAT (NERR, MEM)
|
|
IF (NERR .GT. 0) GOTO 50
|
|
|
|
IEL = 1
|
|
IATR = 1
|
|
|
|
DO IELB = 1, NELBLK
|
|
|
|
C --Block id and start/end for blocks that become multiple blocks
|
|
NRSTRT = 1
|
|
IDEBL3 = IDELB(IELB)
|
|
IBLK = 1
|
|
LSTID = 1
|
|
IF (BLKTYP(IELB) .EQ. 'T') THEN
|
|
NREND = IBPARM(1,IELB) - 1
|
|
NBLK = IBPARM(4,IELB)
|
|
ELSE IF (BLKTYP(IELB) .EQ. 'S') THEN
|
|
NREND = NRTRAN(1)
|
|
NBLK = IBPARM(4,IELB)
|
|
ELSE
|
|
NREND = NEREPL
|
|
NBLK = 1
|
|
END IF
|
|
IF (NBLK .GT. 1) THEN
|
|
LSTID = MAXID
|
|
MAXID = MAXID + NBLK-1
|
|
END IF
|
|
|
|
20 CONTINUE
|
|
|
|
C --Number of elements in the block
|
|
|
|
IF (BLKTYP(IELB) .EQ. 'C') THEN
|
|
NUMELB3(IELB) = 0
|
|
DO I = 1, NUMELB(IELB)
|
|
NUMELB3(IELB) = NUMELB3(IELB) + NREL(IEL+I-1)
|
|
end do
|
|
ELSE
|
|
NUMELB3(IELB) = NUMELB(IELB) * (NREND - NRSTRT + 1)
|
|
END IF
|
|
|
|
C --Number of nodes per element
|
|
|
|
NUMLN3 = NUMLNK(IELB) * 2
|
|
|
|
C --Connectivity and attributes
|
|
|
|
C --Change attributes of input block if they were changed by user
|
|
IF (ELATTR(IELB) .ne. 0.0) then
|
|
call INIREA (NUMELB(IELB) * NUMATR(IELB), ELATTR(IELB),
|
|
& ATRIB(IATR))
|
|
END IF
|
|
|
|
CALL NEWEL1 (BLKTYP(IELB),
|
|
& NUMELB(IELB), NUMELB3(IELB), NRSTRT, NREND,
|
|
& NUMLNK(IELB), NUMLN3, NUMATR(IELB), MAX(NUMATR(IELB),1),
|
|
$ NUMNP, NUMNP3, LINK(1,IEL), IA(KLINK3), ATRIB(IATR),
|
|
$ A(KATR3), IXEL(IEL), INCEL(IEL),
|
|
& NREL(IEL), IELCOL(IEL),
|
|
$ IXNP, NRNP)
|
|
|
|
C --Fixup connectivity if mirrored
|
|
|
|
IF (XMIRR * YMIRR * ZMIRR .LT. 0.0) THEN
|
|
CALL DBMIRR (IELB, IELB, IDEBL3, NUMELB3(IELB), NUMLN3,
|
|
* IA(KLINK3))
|
|
END IF
|
|
|
|
C --Write 3D
|
|
call expelb(ndbout, IDEBL3, NAMELB(IELB), NUMELB3(IELB),
|
|
* NUMLN3, NUMATR(IELB), ierr)
|
|
if (ierr .lt. 0) then
|
|
call exerr('gen3d2', 'Error from expelb', exlmsg)
|
|
go to 50
|
|
endif
|
|
call expelc(ndbout, IDEBL3, IA(KLINK3), ierr)
|
|
if (ierr .lt. 0) then
|
|
call exerr('gen3d2', 'Error from expelc', exlmsg)
|
|
go to 50
|
|
endif
|
|
if (numatr(ielb) .gt. 0) then
|
|
call expeat(ndbout, IDEBL3, A(KATR3), ierr)
|
|
if (ierr .lt. 0) then
|
|
call exerr('gen3d2', 'Error from expeat', exlmsg)
|
|
go to 50
|
|
endif
|
|
end if
|
|
|
|
IF (IBLK .LT. NBLK) THEN
|
|
IBLK = IBLK + 1
|
|
LSTID = LSTID + 1
|
|
IDEBL3 = LSTID
|
|
NRSTRT = NREND + 1
|
|
IF (BLKTYP(IELB) .EQ. 'T') THEN
|
|
IF (NRSTRT .LE. IBPARM(2,IELB)) THEN
|
|
NREND = MIN (IBPARM(2,IELB), NREND + IBPARM(3,IELB))
|
|
ELSE
|
|
NREND = NEREPL
|
|
END IF
|
|
ELSE IF (BLKTYP(IELB) .EQ. 'S') THEN
|
|
NREND = NRSTRT + NRTRAN(IBLK) - 1
|
|
END IF
|
|
GOTO 20
|
|
END IF
|
|
|
|
IEL = IEL + NUMELB(IELB)
|
|
IATR = IATR + NUMATR(IELB) * NUMELB(IELB)
|
|
end do
|
|
|
|
50 CONTINUE
|
|
CALL MDDEL ('LINK3')
|
|
CALL MDDEL ('ATRIB3')
|
|
|
|
RETURN
|
|
END
|
|
|