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
|
||
|
|
|
||
|
|
SUBROUTINE INGRPN (MS, MR, N7, N8, N22, JJ, IIN, IFOUND, IREGN,
|
||
|
|
& NSPR, IFSIDE, ISLIST, LINKR, NHOLDR, IHOLDR, IRGFLG, MERGE,
|
||
|
|
& NOROOM)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE INGRPN = INPUTS A REGION INTO THE DATABASE
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IREGN(MR), NSPR(MR), IFSIDE(MR), ISLIST(MR*4)
|
||
|
|
DIMENSION LINKR(2, MR), IHOLDR(2, MR), IRGFLG(MR), IIN(IFOUND)
|
||
|
|
|
||
|
|
LOGICAL NOROOM, MERGE, ADDLNK
|
||
|
|
|
||
|
|
IZ = 0
|
||
|
|
NOROOM = .TRUE.
|
||
|
|
ADDLNK = .FALSE.
|
||
|
|
|
||
|
|
C ZERO THE LINK ARRAY IF NEEDED
|
||
|
|
|
||
|
|
IF (JJ .GT. N22) THEN
|
||
|
|
N22 = JJ
|
||
|
|
|
||
|
|
C SET UP POINTERS FOR MERGING DATA
|
||
|
|
|
||
|
|
ELSE IF (MERGE) THEN
|
||
|
|
JHOLD = JJ
|
||
|
|
CALL LTSORT (MR, LINKR, JJ, IPNTR, ADDLNK)
|
||
|
|
IF (IPNTR .GT. 0) THEN
|
||
|
|
IF (JHOLD .GT. NHOLDR) NHOLDR = JHOLD
|
||
|
|
CALL LTSORT (MR, IHOLDR, JHOLD, IPNTR, ADDLNK)
|
||
|
|
IF (IPNTR .GT. 0) THEN
|
||
|
|
JJ = IPNTR
|
||
|
|
ELSE
|
||
|
|
JJ = N22 + 1
|
||
|
|
N22 = JJ
|
||
|
|
WRITE(*, 10000) JHOLD, JJ
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MR, IHOLDR, JHOLD, JJ, ADDLNK)
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C ADD THE REGION INTO THE DATABASE
|
||
|
|
|
||
|
|
N7 = N7 + 1
|
||
|
|
J = N7
|
||
|
|
IF (J .GT. MR) RETURN
|
||
|
|
ADDLNK = .TRUE.
|
||
|
|
CALL LTSORT (MR, LINKR, JJ, J, ADDLNK)
|
||
|
|
IREGN(J) = JJ
|
||
|
|
IFSIDE(J) = N8 + 1
|
||
|
|
IRGFLG(J) = 1
|
||
|
|
DO 100 I = 1, IFOUND
|
||
|
|
JJ = IIN(I)
|
||
|
|
IF (JJ .EQ. 0) GO TO 110
|
||
|
|
N8 = N8 + 1
|
||
|
|
IF (N8 .GT. MR*4) RETURN
|
||
|
|
ISLIST(N8) = JJ
|
||
|
|
100 CONTINUE
|
||
|
|
110 CONTINUE
|
||
|
|
NSPR(J) = N8 - IFSIDE(J) + 1
|
||
|
|
IF (NSPR(J) .LT. 1) THEN
|
||
|
|
WRITE(*, 10010) J
|
||
|
|
CALL LTSORT (MR, LINKR, IREGN(J), IZ, ADDLNK)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
NOROOM = .FALSE.
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
10000 FORMAT (' OLD GROUP NO:', I5, ' TO NEW GROUP NO:', I5)
|
||
|
|
10010 FORMAT (' GROUP:', I5, ' HAS LESS THAN ONE REGION', /,
|
||
|
|
& ' THIS GROUP WILL NOT BE INPUT INTO DATABASE')
|
||
|
|
END
|