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.
81 lines
2.3 KiB
81 lines
2.3 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=======================================================================
|
||
|
|
*DECK,RDB2
|
||
|
|
SUBROUTINE RDB2 (IDBLKB,IDBLKA,ICONB,NDLSTB)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE TO GET MESH B DATA
|
||
|
|
|
||
|
|
C Calls subroutine ERROR
|
||
|
|
|
||
|
|
C Called by MAPVAR
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C IDBLKA INT Element block I.D. - donor mesh
|
||
|
|
C IDBLKB INT Element block I.D. - recipient mesh
|
||
|
|
C ICONB INT Connectivity of block in donor mesh (1:nelndb,1:numebb)
|
||
|
|
C NDLSTB INT Vector of nodes in element block donor mesh (1:nodesb)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
character*(32) typ,typa
|
||
|
|
|
||
|
|
include 'bmesh.blk'
|
||
|
|
include 'ebbyeb.blk'
|
||
|
|
include 'ex2tp.blk'
|
||
|
|
|
||
|
|
DIMENSION ICONB(NELNDB,*),NDLSTB(*)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C READ ELEMENT NAMES AND ID BLOCKS
|
||
|
|
|
||
|
|
CALL EXGELB(NTP3EX,IDBLKB,TYP,NUMEBB,NELNDB,NATRIB,IERR)
|
||
|
|
CALL EXUPCS(TYP)
|
||
|
|
CALL EXGELB(NTP2EX,IDBLKA,TYPA,IDUM,IDUM,IDUM,IERR)
|
||
|
|
CALL EXUPCS(TYPA)
|
||
|
|
|
||
|
|
c check here for match of mesh-A element block to mesh-B element block.
|
||
|
|
c Probably need to put this into a DO LOOP over all element block id's
|
||
|
|
c in mesh B. For now, assume that element blocks match if id's match.
|
||
|
|
c Only check element types.
|
||
|
|
|
||
|
|
IF (TYP(1:3) .NE. TYPA(1:3)) THEN
|
||
|
|
CALL ERROR('RDB2',
|
||
|
|
& 'ELEMENT TYPE MISMATCH - MESH-B DOES NOT MATCH MESH-A',
|
||
|
|
& 'ELEMENT BLOCK', IDBLKA,' ',0,
|
||
|
|
& 'Execution will continue, but verify that results are OK',
|
||
|
|
& ' ',0)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL EXGELC(NTP3EX,IDBLKB,ICONB(1,1),IERR)
|
||
|
|
|
||
|
|
DO 5 I = 1,NODESB
|
||
|
|
NDLSTB(I) = 0
|
||
|
|
5 CONTINUE
|
||
|
|
|
||
|
|
DO 10 IEL = 1, NUMEBB
|
||
|
|
DO 20 INODE = 1, NELNDB
|
||
|
|
NDLSTB(ICONB(INODE,IEL)) = 1
|
||
|
|
20 CONTINUE
|
||
|
|
10 CONTINUE
|
||
|
|
|
||
|
|
NUMNDB = 0
|
||
|
|
|
||
|
|
DO 30 I = 1, NODESB
|
||
|
|
IF (NDLSTB(I) .EQ. 1)THEN
|
||
|
|
NUMNDB = NUMNDB + 1
|
||
|
|
NDLSTB(NUMNDB) = I
|
||
|
|
END IF
|
||
|
|
30 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|