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.
129 lines
4.3 KiB
129 lines
4.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
|
||
|
|
|
||
|
|
SUBROUTINE LINKBC (MDIM, MS, I1, I2, NBOUN, N1, N2, N3, N20,
|
||
|
|
& IFLAG, IFLIST, NEPS, LIST, NLPS, IFLINE, ILLIST, IBOUN,
|
||
|
|
& LINKF, IWT, LINKE, LINKS, SIDEOK, NOROOM)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE LINKBC = LINKS UP ALL BOUNDARY FLAG LISTS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE CALLED BY:
|
||
|
|
C READ = READS AND/OR MERGES FASTQ FILE(S)
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C VARIABLES USED:
|
||
|
|
C I1 = THE FIRST FLAG TO BE LINKED
|
||
|
|
C I2 = THE LAST FLAG TO BE LINKED
|
||
|
|
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 SIDEOK = .FALSE. IF IT IS NOT POSSIBLE TO EXPAND SIDES (POINBC'S)
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IFLAG(MDIM), IFLIST(MDIM), NEPS(MDIM), LIST(2, MDIM)
|
||
|
|
DIMENSION LINKF(2, MDIM), IBOUN(MDIM)
|
||
|
|
DIMENSION LINKE(2, MDIM), LINKS(2, MS)
|
||
|
|
DIMENSION NLPS(MS), IFLINE(MS), ILLIST(MS*3), IWT(3, MDIM)
|
||
|
|
|
||
|
|
LOGICAL ADDLNK, MERGE, ADDOLD, NOROOM, SIDEOK, NEWNUM
|
||
|
|
|
||
|
|
IZ = 0
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
MERGE = .FALSE.
|
||
|
|
NOROOM = .FALSE.
|
||
|
|
|
||
|
|
IF (SIDEOK) THEN
|
||
|
|
|
||
|
|
C EXPAND ALL THE SIDES (SETS) TO THEIR RESPECT LINES (ENTITIES)
|
||
|
|
|
||
|
|
DO 130 I = I1, I2
|
||
|
|
100 CONTINUE
|
||
|
|
CALL LTSORT (MDIM, LINKF, IFLAG(I), II, ADDLNK)
|
||
|
|
IF (II .GT. 0) THEN
|
||
|
|
|
||
|
|
C THE FLAG HAS BEEN FOUND
|
||
|
|
|
||
|
|
IFLAG1 = IFLAG(II)
|
||
|
|
J1 = IFLIST(II)
|
||
|
|
J2 = J1 + NEPS(II) - 1
|
||
|
|
DO 120 J = J1, J2
|
||
|
|
JJ = LIST(1, J)
|
||
|
|
IF (JJ .LT. 0) THEN
|
||
|
|
|
||
|
|
C REMOVE THE SIDE FROM THE FLAG LIST
|
||
|
|
|
||
|
|
NEPS(II) = NEPS(II) - 1
|
||
|
|
DO 110 K = J, J2 - 1
|
||
|
|
LIST(1, K) = LIST(1, K + 1)
|
||
|
|
LIST(2, K) = LIST(2, K + 1)
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
C IF THE SIDE EXISTS, REPLACE IT WITH THE LINES IT REPRESENTS
|
||
|
|
|
||
|
|
JJ = -JJ
|
||
|
|
CALL LTSORT (MS, LINKS, JJ, IPNTR, ADDLNK)
|
||
|
|
IF ((JJ .GT. N20) .OR. (IPNTR .LE. 0)) THEN
|
||
|
|
WRITE(*, 10000) JJ
|
||
|
|
ELSE
|
||
|
|
CALL INBOUN (MDIM, IFLAG1, NLPS(IPNTR),
|
||
|
|
& ILLIST(IFLINE(IPNTR)), N1, N2, N3, N2OLD,
|
||
|
|
& MERGE, NOROOM, NEWNUM, IZ, LINKF, IFLAG,
|
||
|
|
& NEPS, IFLIST, LIST, LINKF, IWT, IZ, ADDOLD)
|
||
|
|
IF (NOROOM) RETURN
|
||
|
|
|
||
|
|
C NOW, SEE IF THERE ARE ANY SIDES IN THE NEW I'TH FLAG'S LIST
|
||
|
|
C NOTE THAT THE ONE FIXED HAS NOW BEEN ROTATED TO THE END OF THE LIST.
|
||
|
|
|
||
|
|
GOTO 100
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
120 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
130 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C ALL POSSIBLE SIDE EXPANSION HAS OCCURRED
|
||
|
|
C NOW LINK UP ALL THE LINES
|
||
|
|
|
||
|
|
DO 160 I = I1, I2
|
||
|
|
CALL LTSORT (MDIM, LINKF, IFLAG(I), II, ADDLNK)
|
||
|
|
IF (II .GT. 0) THEN
|
||
|
|
|
||
|
|
C THE FLAG HAS BEEN FOUND
|
||
|
|
|
||
|
|
IFLAG1 = IFLAG(II)
|
||
|
|
J1 = IFLIST(II)
|
||
|
|
J2 = J1 + NEPS(II) - 1
|
||
|
|
DO 140 J = J1, J2
|
||
|
|
JJ = LIST(1, J)
|
||
|
|
IF (JJ .GT. 0) THEN
|
||
|
|
CALL LINKEN (MDIM, JJ, IFLAG1, IFLAG, IFLIST, NEPS,
|
||
|
|
& LIST, LINKF, LINKE, IBOUN, ADDLNK)
|
||
|
|
ELSE
|
||
|
|
CALL MESSAGE('PROBLEMS ELIMINATING SIDES IN LINKBC')
|
||
|
|
ENDIF
|
||
|
|
140 CONTINUE
|
||
|
|
ELSE
|
||
|
|
DO 150 J = 1, NBOUN
|
||
|
|
IF (IBOUN(J) .EQ. IFLAG(I)) IBOUN(J) = 0
|
||
|
|
150 CONTINUE
|
||
|
|
ENDIF
|
||
|
|
160 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (' SIDE NO:', I5, ' IS NOT IN THE DATABASE', /,
|
||
|
|
& ' THUS NO BOUNDARY FLAGS CAN BE ENTERED ALONG THIS SIDE')
|
||
|
|
END
|