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.
68 lines
2.0 KiB
68 lines
2.0 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 DONRM3 (COORD, LTNESS, MAP, DIRCOS, TEMP,
|
||
|
|
* NSEG, NUMNIQ, NUMNP)
|
||
|
|
DIMENSION COORD(NUMNP, *), LTNESS(4,*), MAP(*), DIRCOS(5,*),
|
||
|
|
* TEMP(3,*)
|
||
|
|
|
||
|
|
DO 10 ISEG = 1, NSEG
|
||
|
|
XI = COORD(LTNESS(1,ISEG),1 )
|
||
|
|
YI = COORD(LTNESS(1,ISEG),2 )
|
||
|
|
ZI = COORD(LTNESS(1,ISEG),3 )
|
||
|
|
|
||
|
|
XJ = COORD(LTNESS(2,ISEG),1 )
|
||
|
|
YJ = COORD(LTNESS(2,ISEG),2 )
|
||
|
|
ZJ = COORD(LTNESS(2,ISEG),3 )
|
||
|
|
|
||
|
|
XK = COORD(LTNESS(3,ISEG),1 )
|
||
|
|
YK = COORD(LTNESS(3,ISEG),2 )
|
||
|
|
ZK = COORD(LTNESS(3,ISEG),3 )
|
||
|
|
|
||
|
|
XL = COORD(LTNESS(4,ISEG),1 )
|
||
|
|
YL = COORD(LTNESS(4,ISEG),2 )
|
||
|
|
ZL = COORD(LTNESS(4,ISEG),3 )
|
||
|
|
|
||
|
|
AI = (YK - YI) * (ZL - ZJ) - (ZK - ZI) * (YL - YJ)
|
||
|
|
BJ = (ZK - ZI) * (XL - XJ) - (XK - XI) * (ZL - ZJ)
|
||
|
|
CK = (XK - XI) * (YL - YJ) - (YK - YI) * (XL - XJ)
|
||
|
|
RMAG = SQRT ( AI**2 + BJ**2 + CK**2)
|
||
|
|
|
||
|
|
TEMP(1,ISEG) = AI / RMAG
|
||
|
|
TEMP(2,ISEG) = BJ / RMAG
|
||
|
|
TEMP(3,ISEG) = CK / RMAG
|
||
|
|
|
||
|
|
10 CONTINUE
|
||
|
|
|
||
|
|
DO 20 I=1,NUMNIQ
|
||
|
|
DIRCOS(1,I) = 0.0
|
||
|
|
DIRCOS(2,I) = 0.0
|
||
|
|
DIRCOS(3,I) = 0.0
|
||
|
|
20 CONTINUE
|
||
|
|
|
||
|
|
DO 40 ISEG = 1, NSEG
|
||
|
|
DO 30 J = 1, 4
|
||
|
|
MISEG = MAP( 4 * (ISEG-1) + J )
|
||
|
|
DIRCOS(1,MISEG) = DIRCOS(1,MISEG) + TEMP(1,ISEG)
|
||
|
|
DIRCOS(2,MISEG) = DIRCOS(2,MISEG) + TEMP(2,ISEG)
|
||
|
|
DIRCOS(3,MISEG) = DIRCOS(3,MISEG) + TEMP(3,ISEG)
|
||
|
|
30 CONTINUE
|
||
|
|
40 CONTINUE
|
||
|
|
|
||
|
|
C ... NORMALIZE ALL DIRECTION COSINES
|
||
|
|
|
||
|
|
DO 50 I = 1, NUMNIQ
|
||
|
|
A = DIRCOS(1,I)
|
||
|
|
B = DIRCOS(2,I)
|
||
|
|
C = DIRCOS(3,I)
|
||
|
|
R = SQRT(A**2 + B**2 + C**2)
|
||
|
|
DIRCOS(1,I) = A/R
|
||
|
|
DIRCOS(2,I) = B/R
|
||
|
|
DIRCOS(3,I) = C/R
|
||
|
|
50 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|