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.
109 lines
4.1 KiB
109 lines
4.1 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 LISTBF (MDIM, N, CHOICE, LINK, IFLAG, INUM, IFIRST,
|
||
|
|
& LIST, IWT)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE LISTBF = LISTS BOUNDARY CONDITIONS BY FLAG NUMBERS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE CALLED BY:
|
||
|
|
C LIST = LISTS POINTS, LINES, REGIONS, SCHEMES, AND BOUNDARY
|
||
|
|
C DEFINITIONS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION LINK (2, MDIM), IFLAG (MDIM), INUM (MDIM), IFIRST (MDIM)
|
||
|
|
DIMENSION LIST (2, MDIM), IWT (3, MDIM)
|
||
|
|
|
||
|
|
CHARACTER CHOICE*7
|
||
|
|
|
||
|
|
LOGICAL ADDLNK, EXTRA, FOUND
|
||
|
|
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
FOUND = .FALSE.
|
||
|
|
|
||
|
|
IF (CHOICE (1:5) .EQ. 'POINT') THEN
|
||
|
|
WRITE (*, 10000)
|
||
|
|
ENDIF
|
||
|
|
IF (N .GT. 0) THEN
|
||
|
|
DO 110 I = 1, N
|
||
|
|
CALL LTSORT (MDIM, LINK, I, IPNTR, ADDLNK)
|
||
|
|
IF (IPNTR .GT. 0) THEN
|
||
|
|
FOUND = .TRUE.
|
||
|
|
EXTRA = .FALSE.
|
||
|
|
L1 = IFIRST (IPNTR)
|
||
|
|
L2 = L1 + INUM (IPNTR) - 1
|
||
|
|
100 CONTINUE
|
||
|
|
IF ( (L2 - L1 + 1) .GT. 6) THEN
|
||
|
|
L2 = L1 + 5
|
||
|
|
IF (EXTRA) THEN
|
||
|
|
WRITE (*, 10010) (LIST (1, L), L = L1, L2)
|
||
|
|
ELSE
|
||
|
|
IF (IWT (1, IPNTR) .EQ. 0) THEN
|
||
|
|
WRITE (*, 10020) IFLAG (IPNTR), CHOICE,
|
||
|
|
& (LIST (1, L), L = L1, L2)
|
||
|
|
ELSE
|
||
|
|
IF (IWT (3, IPNTR) .EQ. 0) THEN
|
||
|
|
WRITE (*, 10030) IFLAG (IPNTR), CHOICE,
|
||
|
|
& IWT (1, IPNTR), IWT (2, IPNTR),
|
||
|
|
& (LIST (1, L), L = L1, L2)
|
||
|
|
ELSE
|
||
|
|
WRITE (*, 10040) IFLAG (IPNTR), CHOICE,
|
||
|
|
& IWT (1, IPNTR), IWT (2, IPNTR),
|
||
|
|
& IWT (3, IPNTR), (LIST (1, L), L = L1, L2)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
EXTRA = .TRUE.
|
||
|
|
ENDIF
|
||
|
|
L1 = L2 + 1
|
||
|
|
L2 = IFIRST (IPNTR) + INUM (IPNTR)-1
|
||
|
|
GOTO 100
|
||
|
|
ELSE
|
||
|
|
IF (EXTRA) THEN
|
||
|
|
WRITE (*, 10010) (LIST (1, L), L = L1, L2)
|
||
|
|
ELSE
|
||
|
|
IF (IWT (1, IPNTR) .EQ. 0) THEN
|
||
|
|
WRITE (*, 10020) IFLAG (IPNTR), CHOICE,
|
||
|
|
& (LIST (1, L), L = L1, L2)
|
||
|
|
ELSE
|
||
|
|
IF (IWT (3, IPNTR) .EQ. 0) THEN
|
||
|
|
WRITE (*, 10030) IFLAG (IPNTR), CHOICE,
|
||
|
|
& IWT (1, IPNTR), IWT (2, IPNTR),
|
||
|
|
& (LIST (1, L), L = L1, L2)
|
||
|
|
ELSE
|
||
|
|
WRITE (*, 10040) IFLAG (IPNTR), CHOICE,
|
||
|
|
& IWT (1, IPNTR), IWT (2, IPNTR),
|
||
|
|
& IWT (3, IPNTR), (LIST (1, L), L = L1, L2)
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
110 CONTINUE
|
||
|
|
ELSE
|
||
|
|
FOUND = .TRUE.
|
||
|
|
WRITE (*, 10050) CHOICE
|
||
|
|
ENDIF
|
||
|
|
IF ( .NOT. FOUND) THEN
|
||
|
|
WRITE (*, 10050) CHOICE
|
||
|
|
ENDIF
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (' FLAG BOUN. WEIGHT FIRST FIRST', /,
|
||
|
|
& ' NUMBER TYPE SIDE WT PNT WT LIN POINT OR LINE '//
|
||
|
|
& 'LISTING', /, ' ------ -------- ------ ------ ------ ',
|
||
|
|
& '----------------------------------')
|
||
|
|
10010 FORMAT (' ', 37X, 6I6)
|
||
|
|
10020 FORMAT (' ',1X, I5, 2X, A7, 2X, '-----', 2X, '-----', 2X,
|
||
|
|
& '-----', 2X, 6I6)
|
||
|
|
10030 FORMAT (' ',1X, I5, 2X, A7, 2X, I5, 2X, I5, 2X, '-----', 2X, 6I6)
|
||
|
|
10040 FORMAT (' ',1X, I5, 2X, A7, 2X, I5, 2X, I5, 2X, I5, 2X, 6I6)
|
||
|
|
10050 FORMAT (' *** NO ', A7, ' FLAGS IN THE CURRENT DATABASE ***')
|
||
|
|
END
|