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.
67 lines
1.9 KiB
67 lines
1.9 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
|
|
|
|
C=======================================================================
|
|
SUBROUTINE PLTCV3(N,MASK,PX,PY,PZ,QX,QY,QZ,PPX,PPY,PPZ,QQX,QQY,
|
|
* QQZ,V,Q)
|
|
DIMENSION MASK(*),PX(*),PY(*),PZ(*),QX(*),QY(*),QZ(*),PPX(*),
|
|
* PPY(*),PPZ(*),QQX(*),QQY(*),QQZ(*),V(*),Q(*)
|
|
include 'izbit.inc'
|
|
|
|
CALL CPUMVU(PX,PPX,N)
|
|
CALL CPUMVU(PY,PPY,N)
|
|
CALL CPUMVU(PZ,PPZ,N)
|
|
CALL CPUMVU(QX,QQX,N)
|
|
CALL CPUMVU(QY,QQY,N)
|
|
CALL CPUMVU(QZ,QQZ,N)
|
|
J = 0
|
|
KM = 0
|
|
2140 IF (.NOT. (J.LT.N)) GO TO 2150
|
|
JN = MIN(N-J,32)
|
|
J1 = J
|
|
KM = 1 + KM
|
|
J = J + JN
|
|
M = MASK(KM)
|
|
IF (M.EQ.0) THEN
|
|
GO TO 2140
|
|
|
|
END IF
|
|
|
|
DO 2160 K = 1,JN
|
|
JB = IZBIT(K)
|
|
IF (IAND(JB,M).EQ.0) THEN
|
|
GO TO 2160
|
|
|
|
END IF
|
|
|
|
FP = (PPX(J1+K)-V(1))*Q(1) + (PPY(J1+K)-V(2))*Q(2) +
|
|
* (PPZ(J1+K)-V(3))*Q(3)
|
|
FQ = (QQX(J1+K)-V(1))*Q(1) + (QQY(J1+K)-V(2))*Q(2) +
|
|
* (QQZ(J1+K)-V(3))*Q(3)
|
|
IF (FP.LT.0. .AND. FQ.LT.0.) THEN
|
|
M = IAND(M,NOT(JB))
|
|
|
|
ELSE IF (FP.LT.0.) THEN
|
|
XL = FP/ (FP-FQ)
|
|
PPX(J1+K) = PPX(J1+K) + XL* (QQX(J1+K)-PPX(J1+K))
|
|
PPY(J1+K) = PPY(J1+K) + XL* (QQY(J1+K)-PPY(J1+K))
|
|
PPZ(J1+K) = PPZ(J1+K) + XL* (QQZ(J1+K)-PPZ(J1+K))
|
|
|
|
ELSE IF (FQ.LT.0.) THEN
|
|
XL = FQ/ (FQ-FP)
|
|
QQX(J1+K) = QQX(J1+K) + XL* (PPX(J1+K)-QQX(J1+K))
|
|
QQY(J1+K) = QQY(J1+K) + XL* (PPY(J1+K)-QQY(J1+K))
|
|
QQZ(J1+K) = QQZ(J1+K) + XL* (PPZ(J1+K)-QQZ(J1+K))
|
|
END IF
|
|
|
|
2160 CONTINUE
|
|
MASK(KM) = M
|
|
GO TO 2140
|
|
|
|
2150 CONTINUE
|
|
RETURN
|
|
|
|
END
|
|
|