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
|
||
|
|
|
||
|
|
SUBROUTINE LINKEN (MDIM, JJ, IFLAG1, IFLAG, IFLIST, NEPS, LIST,
|
||
|
|
& LINKF, LINKE, IBOUN, ADDLNK)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE LINKEN = LINKS ENTITIES IN BOUNDARY FLAG LISTS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE CALLED BY:
|
||
|
|
C LINKBC = LINKS UP ALL BOUNDARY FLAG LISTS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C VARIABLES USED:
|
||
|
|
C IFLAG = THE ARRAY OF FLAGS
|
||
|
|
C IFLIST = THE FIRST ENTITY IN LIST TO BE ASSOCIATED WITH A FLAG
|
||
|
|
C NEPS = THE NUMBER OF ENTITIES IN LIST THAT GO WITH A FLAG
|
||
|
|
C LIST = THE LIST OF ENTITIES
|
||
|
|
C LINK = THE LINK TO THE FLAG LIST
|
||
|
|
C IBOUN = THE LINK FROM THE ENTITY TO THE FLAGS
|
||
|
|
C MDIM = THE DIMENSIONING PARAMETER FOR THE LIST
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IFLAG (MDIM), IFLIST (MDIM), NEPS (MDIM), LIST (2, MDIM)
|
||
|
|
DIMENSION LINKF (2, MDIM), IBOUN (MDIM), LINKE (2, MDIM)
|
||
|
|
|
||
|
|
LOGICAL ADDLNK
|
||
|
|
|
||
|
|
CALL LTSORT (MDIM, LINKE, JJ, L, ADDLNK)
|
||
|
|
IF (L .LE. 0) THEN
|
||
|
|
CALL MESSAGE('BOUNDARY CONDITION LINK ATTEMPTED')
|
||
|
|
CALL MESSAGE('TO A NONEXISTENT ENTITY')
|
||
|
|
WRITE ( * , 10000)IFLAG1, JJ
|
||
|
|
CALL MESSAGE('CHECK POINBC, LINEBC, OR SIDEBC (S)')
|
||
|
|
CALL MESSAGE(' ')
|
||
|
|
ELSEIF (IBOUN (L) .LE. 0) THEN
|
||
|
|
IBOUN (L) = IFLAG1
|
||
|
|
ELSE
|
||
|
|
K = IBOUN (L)
|
||
|
|
100 CONTINUE
|
||
|
|
CALL LTSORT (MDIM, LINKF, K, IPNTR, ADDLNK)
|
||
|
|
IFLAG2 = IFLAG (IPNTR)
|
||
|
|
IF (IFLAG2 .EQ. IFLAG1)GOTO 120
|
||
|
|
M1 = IFLIST (IPNTR)
|
||
|
|
M2 = M1 + NEPS (IPNTR) - 1
|
||
|
|
DO 110 M = M1, M2
|
||
|
|
IF (LIST (1, M) .EQ. JJ) THEN
|
||
|
|
IF (LIST (2, M) .GT. 0) THEN
|
||
|
|
K = LIST (2, M)
|
||
|
|
GOTO 100
|
||
|
|
ELSE
|
||
|
|
LIST (2, M) = IFLAG1
|
||
|
|
GOTO 120
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
110 CONTINUE
|
||
|
|
CALL MESSAGE('PROBLEM LINKING BOUNDARY FLAG TABLES')
|
||
|
|
ENDIF
|
||
|
|
120 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (' FLAG: ', I5, ' ENTITY ATTEMPTED:', I5)
|
||
|
|
|
||
|
|
END
|