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.
257 lines
8.6 KiB
257 lines
8.6 KiB
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 CHKWT (MP, ML, MS, MLIST, MFLAG, NNUID, MXLPS, LINKP,
|
|
& LINKL, LINKS, NUID, IFLG, ILEN, IPTR, NLIST, IFLAG, LTYPE,
|
|
& LCON, NLPS, IFLINE, ILLIST, COOR, JPOINT, JSIDE, ILOC, JLOC,
|
|
& NIX, ILIST, XLIST, ADDLNK, ISPNT, ERR)
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE CHKWT = CHECKS THE WEIGHTING COMBINATION FOR FLAGS TO
|
|
C MAKE SURE THE DEFINITION IS VALID. IT RETURNS
|
|
C THE LOCATION OF THE BEGINNING POINT IN THE
|
|
C FLAG NODE LIST AS JLOC. THE ARRAY ILIST AND
|
|
C XLIST ARE ALSO SET UP AS X VALUES OF THE SIDE
|
|
C AS IT MOVES FORWARD.
|
|
|
|
C***********************************************************************
|
|
|
|
C SUBROUTINE CALLED BY:
|
|
C ADDWT = ADDS THE WEIGHTING FACTORS TO ANY NODES WITH
|
|
C FLAGS CONTAINING WEIGHTS
|
|
|
|
C***********************************************************************
|
|
|
|
DIMENSION IFLG (MFLAG), ILEN (MFLAG), IPTR (MFLAG), NLIST (MLIST)
|
|
DIMENSION NUID (NNUID), LINKP (2, MP)
|
|
DIMENSION LINKS (2, MS), LINKL (2, ML)
|
|
DIMENSION COOR (2, MP), LTYPE (ML), LCON (3, ML)
|
|
DIMENSION NLPS (MS), IFLINE (MS), ILLIST (MS*3)
|
|
DIMENSION ILIST (MXLPS), XLIST (MXLPS)
|
|
|
|
LOGICAL ERR, ADDLNK, ISPNT
|
|
|
|
ERR = .TRUE.
|
|
|
|
C CHECK TO MAKE SURE THE FLAG HAS NODES GENERATED ALONG IT
|
|
|
|
DO 100 I = 1, MFLAG
|
|
IF (IFLAG .EQ. IFLG (I)) THEN
|
|
ILOC = I
|
|
GOTO 110
|
|
ENDIF
|
|
100 CONTINUE
|
|
WRITE (*, 10000)IFLAG
|
|
RETURN
|
|
110 CONTINUE
|
|
|
|
C CHECK TO MAKE SURE THE BEGINNING POINT IS DEFINED
|
|
|
|
CALL LTSORT (MP, LINKP, JPOINT, JPPNTR, ADDLNK)
|
|
IF (JPPNTR .LE. 0) THEN
|
|
WRITE (*, 10010)JPOINT, IFLAG
|
|
RETURN
|
|
ENDIF
|
|
|
|
C CHECK TO MAKE SURE THE NODE AT THE BEGINNING POINT IS IN THE LIST
|
|
C OF NODES FOR THE FLAG - RETURN THIS LIST LOCATION IF IT IS THERE
|
|
|
|
JLOC = 0
|
|
J1 = IPTR (ILOC)
|
|
J2 = IPTR (ILOC) + ILEN (ILOC) - 1
|
|
DO 120 I = J1, J2
|
|
IF (NUID (NLIST (I)) .EQ. JPOINT) THEN
|
|
JLOC = I
|
|
ENDIF
|
|
120 CONTINUE
|
|
IF (JLOC .EQ. 0) THEN
|
|
WRITE (*, 10020)JPOINT
|
|
RETURN
|
|
ENDIF
|
|
|
|
C CHECK TO MAKE SURE THE SIDE OR LINE OR POINT IS DEFINED
|
|
|
|
IF (ISPNT) THEN
|
|
CALL LTSORT (MP, LINKP, JSIDE, IPNTR, ADDLNK)
|
|
IF (IPNTR .LE. 0)WRITE (*, 10030)JSIDE, IFLAG
|
|
RETURN
|
|
ELSEIF (JSIDE .LT. 0) THEN
|
|
CALL LTSORT (ML, LINKL, IABS (JSIDE), JLPNTR, ADDLNK)
|
|
IF (JLPNTR .LE. 0) THEN
|
|
WRITE (*, 10040)IABS (JSIDE), IFLAG
|
|
RETURN
|
|
ENDIF
|
|
ELSE
|
|
CALL LTSORT (MS, LINKS, JSIDE, JSPNTR, ADDLNK)
|
|
IF (JSPNTR .LE. 0) THEN
|
|
WRITE (*, 10050)JSIDE, IFLAG
|
|
RETURN
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C CHECK TO MAKE SURE SIDE'S LINE DEFINITIONS ARE ALL THERE
|
|
C AND ARE IN MONOTONICALLY INCREASING X ORDER
|
|
|
|
IF (JSIDE .GT. 0) THEN
|
|
J1 = IFLINE (JSPNTR)
|
|
J2 = IFLINE (JSPNTR) + NLPS (JSPNTR) - 1
|
|
ELSE
|
|
J1 = 1
|
|
J2 = 1
|
|
ENDIF
|
|
NIX = J2 - J1 + 2
|
|
DO 130 J = J1, J2
|
|
IF (JSIDE .GT. 0) THEN
|
|
KK = ILLIST (J)
|
|
CALL LTSORT (ML, LINKL, KK, IPNTR, ADDLNK)
|
|
IF ((KK .LE. 0) .OR. (IPNTR .LE. 0)) THEN
|
|
WRITE (*, 10060)JSIDE, KK
|
|
RETURN
|
|
ENDIF
|
|
ELSE
|
|
KK = IABS (JSIDE)
|
|
IPNTR = JLPNTR
|
|
ENDIF
|
|
ILIST (J - J1 + 1) = IPNTR
|
|
|
|
C CHECK TO MAKE SURE LINE'S POINT DEFINITIONS ARE ALL THERE
|
|
|
|
IP1 = LCON (1, IPNTR)
|
|
IP2 = LCON (2, IPNTR)
|
|
IP3 = IABS (LCON (3, IPNTR))
|
|
CALL LTSORT (MP, LINKP, IP1, IPNTR1, ADDLNK)
|
|
CALL LTSORT (MP, LINKP, IP2, IPNTR2, ADDLNK)
|
|
IF (IP3 .NE. 0) THEN
|
|
CALL LTSORT (MP, LINKP, IABS (IP3), IPNTR3, ADDLNK)
|
|
ELSE
|
|
IP3 = 0
|
|
ENDIF
|
|
|
|
IF ((IP1 .LE. 0) .OR. (IPNTR1 .LE. 0)) THEN
|
|
IF (JSIDE .GT. 0) THEN
|
|
WRITE (*, 10070)KK, JSIDE, IP1
|
|
ELSE
|
|
WRITE (*, 10080)KK, IP1
|
|
ENDIF
|
|
RETURN
|
|
ELSEIF ((IP2 .LE. 0) .OR. (IPNTR2 .LE. 0)) THEN
|
|
IF (JSIDE .GT. 0) THEN
|
|
WRITE (*, 10070)KK, JSIDE, IP2
|
|
ELSE
|
|
WRITE (*, 10080)KK, IP2
|
|
ENDIF
|
|
RETURN
|
|
ELSEIF ((LTYPE (IPNTR) .NE. 1) .AND. ((IP3 .EQ. 0) .OR.
|
|
& (IPNTR3 .LE. 0))) THEN
|
|
IF (JSIDE .GT. 0) THEN
|
|
WRITE (*, 10070)KK, JSIDE, IP3
|
|
ELSE
|
|
WRITE (*, 10080)KK, IP3
|
|
ENDIF
|
|
RETURN
|
|
ENDIF
|
|
130 CONTINUE
|
|
|
|
C GET THE XLIST VALUES SET UP FOR THIS SIDE
|
|
|
|
IF (NIX .EQ. 2) THEN
|
|
CALL LTSORT (MP, LINKP, LCON (1, ILIST (1)), IP1, ADDLNK)
|
|
CALL LTSORT (MP, LINKP, LCON (2, ILIST (1)), IP2, ADDLNK)
|
|
IF (COOR (1, IP1) .LT. COOR (1, IP2)) THEN
|
|
XLIST (1) = COOR (1, IP1)
|
|
XLIST (2) = COOR (1, IP2)
|
|
ELSEIF (COOR (1, IP1) .GT. COOR (1, IP2)) THEN
|
|
XLIST (1) = COOR (1, IP2)
|
|
XLIST (2) = COOR (1, IP1)
|
|
ELSE
|
|
WRITE (*, 10090)JSIDE
|
|
RETURN
|
|
ENDIF
|
|
ELSE
|
|
|
|
C DEFINE VALUE OF KP, THE BEGINNING CONNECTIVITY POINT
|
|
|
|
K1 = LCON (1, ILIST (1))
|
|
K2 = LCON (2, ILIST (1))
|
|
L1 = LCON (1, ILIST (2))
|
|
L2 = LCON (2, ILIST (2))
|
|
KP = 0
|
|
IF ((K1 .EQ. L1) .OR. (K1 .EQ. L2)) THEN
|
|
KP = K1
|
|
CALL LTSORT (MP, LINKP, K2, K2P, ADDLNK)
|
|
XLIST (1) = COOR (1, K2P)
|
|
ELSEIF ((K2 .EQ. L1) .OR. (K2 .EQ. L2)) THEN
|
|
KP = K2
|
|
CALL LTSORT (MP, LINKP, K1, K1P, ADDLNK)
|
|
XLIST (1) = COOR (1, K1P)
|
|
ELSE
|
|
WRITE (*, 10100)ILLIST (J1), JSIDE
|
|
RETURN
|
|
ENDIF
|
|
|
|
C NOWLOOP THROUGH THE REST OF THE LINES TO GET THE XLIST
|
|
|
|
DO 140 M = 2, NIX - 1
|
|
L1 = LCON (1, ILIST (M))
|
|
L2 = LCON (2, ILIST (M))
|
|
IF (KP .EQ. L1) THEN
|
|
KP = L2
|
|
CALL LTSORT (MP, LINKP, L1, L1P, ADDLNK)
|
|
XLIST (M) = COOR (1, L1P)
|
|
ELSEIF (KP .EQ. L2) THEN
|
|
KP = L1
|
|
CALL LTSORT (MP, LINKP, L2, L2P, ADDLNK)
|
|
XLIST (M) = COOR (1, L2P)
|
|
ELSE
|
|
WRITE (*, 10100)ILLIST (J1 + M - 2), JSIDE
|
|
RETURN
|
|
ENDIF
|
|
140 CONTINUE
|
|
CALL LTSORT (MP, LINKP, KP, KPP, ADDLNK)
|
|
XLIST (NIX) = COOR (1, KPP)
|
|
|
|
C NOWCHECK TO MAKE SURE THE LINES ARE INCREASING MONOTONICALLY IN X
|
|
|
|
DO 150 M = 2, NIX
|
|
IF (XLIST (M) .LT. XLIST (M - 1)) THEN
|
|
WRITE (*, 10090)JSIDE
|
|
RETURN
|
|
ENDIF
|
|
150 CONTINUE
|
|
ENDIF
|
|
ERR = .FALSE.
|
|
RETURN
|
|
|
|
10000 FORMAT (' FLAG NUMBER:', I5, ' HAS NOT BEEN USED IN GENERATING',
|
|
& /, ' THIS MESH - THUS NO WEIGHTING IS POSSIBLE')
|
|
10010 FORMAT (' THE BEGINNING POINT:', I5, ' FOR FLAG:', I5,
|
|
& ' IS NOT DEFINED ', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS POINT POSSIBLE')
|
|
10020 FORMAT (' THE BEGINNING POINT:', I5, ' IS NOT IN THE FLAG', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING POSSIBLE WITH THIS FLAG/POINT '//
|
|
& 'SET.')
|
|
10030 FORMAT (' THE WEIGHTING POINT:', I5, ' FOR FLAG:', I5,
|
|
& ' IS NOT DEFINED', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS POINT POSSIBLE')
|
|
10040 FORMAT (' THE WEIGHTING LINE:', I5, ' FOR FLAG:', I5,
|
|
& ' IS NOT DEFINED', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS LINE POSSIBLE')
|
|
10050 FORMAT (' THE WEIGHTING SIDE:', I5, ' FOR FLAG:', I5,
|
|
& ' IS NOT DEFINED', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS SIDE POSSIBLE')
|
|
10060 FORMAT (' FOR SIDE:', I5, ' LINE:', I5, ' DOES NOT EXIST', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS SIDE POSSIBLE')
|
|
10070 FORMAT (' ON LINE:', I5, ' IN SIDE:', I5, ' POINT:', I5,
|
|
& ' DOES NOT EXIST', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS SIDE POSSIBLE')
|
|
10080 FORMAT (' ON LINE:', I5, ' POINT:', I5, ' DOES NOT EXIST', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS LINE POSSIBLE')
|
|
10090 FORMAT (' SIDE:', I5, ' IS NOT MONOTONICALLY INCREASING IN X', /,
|
|
& ' NO BOUNDARY FLAG WEIGHTING WITH THIS SIDE POSSIBLE')
|
|
10100 FORMAT (' LINE:', I5, ' DOES NOT CONNECT PROPERLY IN SIDE:', I5,
|
|
& /, ' NO BOUNDARY FLAG WEIGHTING WITH THIS SIDE POSSIBLE')
|
|
|
|
END
|
|
|