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 . S,T,HSL
46 my_real
47 . x(3,*),v(3,*)
48 my_real
49 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
50 . ls1,ls2,lt1,lt2
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com08_c.inc"
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I,J,J1,J2,J3,J4,II,JJ,L,NN,NIR
59C REAL
60 my_real
61 . X21,X32,X34,X41,Y21,Y32,Y34,Y41,Z21,Z32,Z34,Z41,
62 . sm,sp,tm,tp,sm2,sp2,tm2,tp2,sm3,sp3,tm3,tp3,suma,s1,s2
63 my_real
64 . xm(4),ym(4),zm(4)
65C=======================================================================
66 nir=4
67 IF (inod(3) == inod(4)) THEN
68 nir=3
69 xm(4)=zero
70 ym(4)=zero
71 zm(4)=zero
72 ENDIF
73 DO jj=1,nir
74 j=inod(jj)
75 xm(jj)=x(1,j)+ v(1,j)*dt12*half
76 ym(jj)=x(2,j)+ v(2,j)*dt12*half
77 zm(jj)=x(3,j)+ v(3,j)*dt12*half
78 ENDDO
79C-----repere local main
80 x21 = xm(2) - xm(1)
81 x32 = xm(3) - xm(2)
82 x34 = xm(3) - xm(4)
83 x41 = xm(4) - xm(1)
84 y21 = ym(2) - ym(1)
85 y32 = ym(3) - ym(2)
86 y34 = ym(3) - ym(4)
87 y41 = ym(4) - ym(1)
88 z21 = zm(2) - zm(1)
89 z32 = zm(3) - zm(2)
90 z34 = zm(3) - zm(4)
91 z41 = zm(4) - zm(1)
92
93 e1x = (x21+x34 )
94 e1y = (y21+y34 )
95 e1z = (z21+z34 )
96
97 e2x = (x32+x41 )
98 e2y = (y32+y41 )
99 e2z = (z32+z41 )
100
101 e3x = e1y*e2z-e1z*e2y
102 e3y = e1z*e2x-e1x*e2z
103 e3z = e1x*e2y-e1y*e2x
104C
105 suma = e3x*e3x+e3y*e3y+e3z*e3z
106 suma = one / max(sqrt(suma),em20)
107 e3x = e3x * suma
108 e3y = e3y * suma
109 e3z = e3z * suma
110C
111 s1 = e1x*e1x+e1y*e1y+e1z*e1z
112 s2 = e2x*e2x+e2y*e2y+e2z*e2z
113 suma = sqrt(s1/s2)
114 e1x = e1x + (e2y*e3z-e2z*e3y)*suma
115 e1y = e1y + (e2z*e3x-e2x*e3z)*suma
116 e1z = e1z + (e2x*e3y-e2y*e3x)*suma
117C
118 suma = e1x*e1x+e1y*e1y+e1z*e1z
119 suma = one / max(sqrt(suma),em20)
120 e1x = e1x * suma
121 e1y = e1y * suma
122 e1z = e1z * suma
123C
124 e2x = e3y * e1z - e3z * e1y
125 e2y = e3z * e1x - e3x * e1z
126 e2z = e3x * e1y - e3y * e1x
127C----- longueurs
128 ls1 = sqrt(x21**2 + y21**2 + z21**2)
129 ls2 = sqrt(x34**2 + y34**2 + z34**2)
130 lt1 = sqrt(x41**2 + y41**2 + z41**2)
131 lt2 = sqrt(x32**2 + y32**2 + z32**2)
132C-----------
133 RETURN
134 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