OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2curv_rep.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i2curv_rep ../engine/source/interfaces/interf/i2curv_rep.F
25!||--- called by ------------------------------------------------------
26!|| i2curvf ../engine/source/interfaces/interf/i2curvf.F
27!|| i2curvfp ../engine/source/interfaces/interf/i2curvfp.F
28!|| i2curvv ../engine/source/interfaces/interf/i2curvv.F
29!||====================================================================
30 SUBROUTINE i2curv_rep(
31 . INOD , X ,V ,LS1 ,LS2 ,
32 . LT1 ,LT2 ,E1X ,E1Y ,E1Z ,
33 . E2X ,E2Y ,E2Z ,E3X ,E3Y ,
34 . E3Z )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER INOD(4)
43C REAL
44 my_real
45 . X(3,*),V(3,*)
46 my_real
47 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
48 . ls1,ls2,lt1,lt2
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com08_c.inc"
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER J, JJ, NIR
57C REAL
58 my_real
59 . X21,X32,X34,X41,Y21,Y32,Y34,Y41,Z21,Z32,Z34,Z41,
60 . tp22223333,suma,s1,s2
61 my_real
62 . xm(4),ym(4),zm(4)
63C=======================================================================
64 nir=4
65 IF (inod(3) == inod(4)) THEN
66 nir=3
67 xm(4)=zero
68 ym(4)=zero
69 zm(4)=zero
70 ENDIF
71 DO jj=1,nir
72 j=inod(jj)
73 xm(jj)=x(1,j)+ v(1,j)*dt12*half
74 ym(jj)=x(2,j)+ v(2,j)*dt12*half
75 zm(jj)=x(3,j)+ v(3,j)*dt12*half
76 ENDDO
77C-----local frame main
78 x21 = xm(2) - xm(1)
79 x32 = xm(3) - xm(2)
80 x34 = xm(3) - xm(4)
81 x41 = xm(4) - xm(1)
82 y21 = ym(2) - ym(1)
83 y32 = ym(3) - ym(2)
84 y34 = ym(3) - ym(4)
85 y41 = ym(4) - ym(1)
86 z21 = zm(2) - zm(1)
87 z32 = zm(3) - zm(2)
88 z34 = zm(3) - zm(4)
89 z41 = zm(4) - zm(1)
90
91 e1x = (x21+x34 )
92 e1y = (y21+y34 )
93 e1z = (z21+z34 )
94
95 e2x = (x32+x41 )
96 e2y = (y32+y41 )
97 e2z = (z32+z41 )
98
99 e3x = e1y*e2z-e1z*e2y
100 e3y = e1z*e2x-e1x*e2z
101 e3z = e1x*e2y-e1y*e2x
102C
103 suma = e3x*e3x+e3y*e3y+e3z*e3z
104 suma = one / max(sqrt(suma),em20)
105 e3x = e3x * suma
106 e3y = e3y * suma
107 e3z = e3z * suma
108C
109 s1 = e1x*e1x+e1y*e1y+e1z*e1z
110 s2 = e2x*e2x+e2y*e2y+e2z*e2z
111 suma = sqrt(s1/s2)
112 e1x = e1x + (e2y*e3z-e2z*e3y)*suma
113 e1y = e1y + (e2z*e3x-e2x*e3z)*suma
114 e1z = e1z + (e2x*e3y-e2y*e3x)*suma
115C
116 suma = e1x*e1x+e1y*e1y+e1z*e1z
117 suma = one / max(sqrt(suma),em20)
118 e1x = e1x * suma
119 e1y = e1y * suma
120 e1z = e1z * suma
121C
122 e2x = e3y * e1z - e3z * e1y
123 e2y = e3z * e1x - e3x * e1z
124 e2z = e3x * e1y - e3y * e1x
125C----- longueurs
126 ls1 = sqrt(x21**2 + y21**2 + z21**2)
127 ls2 = sqrt(x34**2 + y34**2 + z34**2)
128 lt1 = sqrt(x41**2 + y41**2 + z41**2)
129 lt2 = sqrt(x32**2 + y32**2 + z32**2)
130C-----------
131 RETURN
132 END
i2curv_rep
subroutine i2curv_rep(inod, x, v, ls1, ls2, lt1, lt2, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition i2curv_rep.F:35
max
#define max(a, b)
Definition macros.h:21