Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.

218 lines
6.9 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 DATAOK (MP, ML, MS, MR, L, KNUM, COOR, ILINE, LTYPE,
& KNINT, LCON, NLPS, IFLINE, ILLIST, NSPR, IFSIDE, ISLIST, LINKP,
& LINKL, LINKS, SIZE, ERRCHK, ERR)
C***********************************************************************
C SUBROUTINE FILLOK = CHECKS TO MAKE SURE NONEXISTENT DATA IS NOT
C BEING REFERENCED IN THE REGION DEFINITIONS
C***********************************************************************
DIMENSION COOR (2, MP), LINKP (2, MP)
DIMENSION ILINE (ML), LTYPE (ML), KNINT (ML), LCON (3, ML)
DIMENSION LINKL (2, ML)
DIMENSION NLPS (MS), IFLINE (MS), ILLIST (MS*3), LINKS (2, MS)
DIMENSION NSPR (MR), IFSIDE (MR), ISLIST (MR*4)
LOGICAL ERR, ADDLNK, ERRCHK
ERR = .TRUE.
ADDLNK = .FALSE.
DO 130 I = IFSIDE (L), IFSIDE (L) + NSPR (L)-1
C CHECK TO MAKE SURE REGION'S SIDE DEFINITIONS ARE ALL THERE
IF (ISLIST (I).GT.0)THEN
II = ISLIST (I)
CALL LTSORT (MS, LINKS, II, IPNTR, ADDLNK)
IF (IPNTR.LE.0) THEN
IF (ERRCHK) THEN
WRITE (*, 10000)KNUM, II
RETURN
ELSE
GOTO 120
ENDIF
END IF
C CHECK TO MAKE SURE SIDE'S LINE DEFINITIONS ARE ALL THERE
CALL LTSORT (MS, LINKS, II, JJ, ADDLNK)
DO 110 J = IFLINE (JJ), IFLINE (JJ) + NLPS (JJ)-1
KK = ILLIST (J)
CALL LTSORT (ML, LINKL, KK, LL, ADDLNK)
IF ((KK.LE.0) .OR. (LL.LE.0)) THEN
IF (ERRCHK) THEN
WRITE (*, 10010)II, KK
RETURN
ELSE
GOTO 100
ENDIF
END IF
C CHECK TO MAKE SURE LINE'S POINT DEFINITIONS ARE ALL THERE
I1 = LCON (1, LL)
I2 = LCON (2, LL)
I3 = LCON (3, LL)
CALL LTSORT (MP, LINKP, I1, J1, ADDLNK)
CALL LTSORT (MP, LINKP, I2, J2, ADDLNK)
IF (I3 .NE. 0) THEN
CALL LTSORT (MP, LINKP, IABS (I3), J3, ADDLNK)
ELSE
J3 = 0
END IF
IF ((I1.LE.0) .OR. (J1.LE.0)) THEN
IF (ERRCHK) THEN
WRITE (*, 10030)KK, I1
RETURN
ELSE
GOTO 100
ENDIF
ELSEIF ((I2.LE.0) .OR. (J2.LE.0)) THEN
IF (ERRCHK) THEN
WRITE (*, 10030)KK, I2
RETURN
ELSE
GOTO 100
ENDIF
ELSEIF ((LTYPE (LL) .NE. 1) .AND. ((I3 .EQ. 0) .OR.
& (J3.LE.0))) THEN
IF (ERRCHK) THEN
WRITE (*, 10030)KK, I3
RETURN
ELSE
GOTO 100
ENDIF
END IF
C CHECK TO INSURE AN INTEGRAL ASSIGNMENT
IF (IABS (KNINT (LL)) .EQ. 0) THEN
IF (I3 .LT. 0)J3 = -J3
CALL LINLEN (MP, COOR, LINKP, KNUM, ILINE(LL),
& LTYPE(LL), I3, J1, J2, J3, DIST, ERR)
IF (ERR) THEN
IF (ERRCHK) THEN
WRITE (*, 10020)KK, IABS (KNINT (LL))
RETURN
ELSE
GOTO 100
ENDIF
ELSE
IF (SIZE .LE. 0.) THEN
KNINT (LL) = 1
ELSE
KNINT (LL) = MAX0 (NINT (DIST/SIZE), 1)
END IF
END IF
END IF
100 CONTINUE
110 CONTINUE
C CHECK TO MAKE SURE REGION'S LINE DEFINITIONS ARE ALL THERE
ELSEIF (ISLIST (I) .LT. 0) THEN
KK = IABS (ISLIST (I))
CALL LTSORT (ML, LINKL, KK, LL, ADDLNK)
IF ( (KK .LE. 0) .OR. (LL .LE. 0) ) THEN
IF (ERRCHK) THEN
WRITE (*, 10010)KNUM, KK
RETURN
ELSE
GOTO 120
ENDIF
END IF
C CHECK TO MAKE SURE LINE'S POINT DEFINITIONS ARE ALL THERE
I1 = LCON (1, LL)
I2 = LCON (2, LL)
I3 = LCON (3, LL)
CALL LTSORT (MP, LINKP, I1, J1, ADDLNK)
CALL LTSORT (MP, LINKP, I2, J2, ADDLNK)
IF (I3 .NE. 0) THEN
CALL LTSORT (MP, LINKP, IABS (I3), J3, ADDLNK)
ELSE
J3 = 0
END IF
IF ((I1.LE.0) .OR. (J1.LE.0)) THEN
IF (ERRCHK) THEN
WRITE (*, 10030)KK, I1
RETURN
ELSE
GOTO 120
ENDIF
ELSEIF ((I2.LE.0) .OR. (J2.LE.0)) THEN
IF (ERRCHK) THEN
WRITE (*, 10030)KK, I2
RETURN
ELSE
GOTO 120
ENDIF
ELSEIF ((LTYPE (LL) .NE. 1) .AND. ((I3 .EQ. 0) .OR.
& (J3.LE.0))) THEN
IF (ERRCHK) THEN
WRITE (*, 10030)KK, I3
RETURN
ELSE
GOTO 120
ENDIF
END IF
C CHECK TO MAKE SURE INTERVAL ASSIGNMENT IS HANDLED
IF (IABS (KNINT (LL)) .EQ. 0) THEN
C**MBS/29-JUN-1989/ DO NOT NEGATE POINTER TO CENTER OF CLOCKWISE ARC
C IF (I3 .LT. 0)J3 = -J3
CALL LINLEN (MP, COOR, LINKP, KNUM, ILINE(LL),
& LTYPE(LL), I3, J1, J2, J3, DIST, ERR)
IF (ERR) THEN
IF (ERRCHK) THEN
WRITE (*, 10020)KK, IABS (KNINT (LL))
RETURN
ELSE
GOTO 120
ENDIF
ELSE
IF (SIZE .LE. 0.) THEN
KNINT (LL) = 1
ELSE
KNINT (LL) = MAX0 (NINT (DIST/SIZE), 1)
END IF
END IF
END IF
C A ZERO SIDE NUMBER HAS BEEN FOUND
ELSE
IF (ERRCHK) THEN
WRITE (*, 10000)KNUM, ISLIST (I)
ELSE
GOTO 120
ENDIF
END IF
120 CONTINUE
130 CONTINUE
C ALL DEFINITIONS ARE IN ORDER
ERR = .FALSE.
RETURN
10000 FORMAT (' FOR REGION:', I5, ' SIDE:', I5, ' DOES NOT EXIST')
10010 FORMAT (' FOR SIDE:', I5, ' LINE:', I5, ' DOES NOT EXIST')
10020 FORMAT (' FOR LINE:', I5, ' INTERVAL OF:', I5, ' IS NOT WORKING')
10030 FORMAT (' FOR LINE:', I5, ' POINT:', I5, ' DOES NOT EXIST')
END