OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2curvfp.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!|| i2curvfp ../engine/source/interfaces/interf/i2curvfp.F
25!||--- called by ------------------------------------------------------
26!|| intti2f ../engine/source/interfaces/interf/intti2f.F
27!||--- calls -----------------------------------------------------
28!|| i2_fform ../engine/source/interfaces/interf/i2_fform.F
29!|| i2curv_rep ../engine/source/interfaces/interf/i2curv_rep.F
30!|| i2forces ../engine/source/interfaces/interf/i2forces.F
31!|| inv3 ../engine/source/elements/joint/rskew33.F
32!||--- uses -----------------------------------------------------
33!|| h3d_mod ../engine/share/modules/h3d_mod.F
34!||====================================================================
35 SUBROUTINE i2curvfp(
36 . MS ,IN ,X ,V ,VR ,
37 . A ,AR ,STIFN ,STIFR ,WEIGHT ,
38 . NSV ,MSR ,IRTL ,IRECT ,CRST ,
39 . NSN ,NMN ,IDEL2 ,I0 ,I2SIZE ,
40 . IADI2 ,MMASS ,SMASS ,SINER ,FSKYI2 ,
41 . FSAV ,FNCONT ,H3D_DATA,FNCONTP ,FTCONTP)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE h3d_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NSN, NMN, I0,I2SIZE,IDEL2
54 INTEGER IRECT(4,*),NSV(*),MSR(*),IRTL(*),WEIGHT(*),IADI2(4,*)
55C REAL
56 my_real
57 . MS(*),IN(*),MMASS(*),SMASS(*),SINER(*),X(3,*),V(3,*),VR(3,*),
58 . A(3,*),AR(3,*),STIFN(*),STIFR(*),FSAV(*),CRST(2,*),
59 . fskyi2(i2size,*),fncont(3,*),fncontp(3,*),ftcontp(3,*)
60 TYPE (h3d_database) :: h3d_data
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I1,I2,I3,I4,II,IS,IM,JJ,L,NN,NIR
65 INTEGER INOD(4)
66 my_real
67 . xms,ins,stfn,stfr,fs(3),moms(3),ls1,ls2,lt1,lt2,
68 . ls,lt,len,s,t,xc,yc,zc,dm1,dm2,din1,din2,din3,
69 . sumhrs,sumhrt,sumhprs,sumhprt
70 my_real
71 . fsloc(6),fmloc(4,6),rot(9),roti(9),dm(4),din(4),dstfn(4),
72 . dstfr(4),h(4),hh(4),hrs(4),hrt(4),hps(4),hpt(4),hprs(4),
73 . hprt(4),hxs(4),hxt(4),fx(4),fy(4),fz(4)
74C======================================================================|
75 nir = 4
76C----------------------
77#include "vectorize.inc"
78 DO ii=1,nmn
79 im=msr(ii)
80 mmass(ii)=ms(im)
81 in(im)=max(em20,in(im))
82 ENDDO
83C----------------------
84 DO ii=1,nsn
85 is = nsv(ii)
86 IF (is > 0) THEN
87 IF (weight(is) == 1) THEN
88 l = irtl(ii)
89 DO jj=1,nir
90 inod(jj) = irect(jj,l)
91 ENDDO
92C---
93 CALL i2curv_rep(inod , x ,v ,ls1 ,ls2 ,
94 . lt1 ,lt2 ,rot(1) ,rot(4) ,rot(7) ,
95 . rot(2) ,rot(5) ,rot(8) ,rot(3) ,rot(6) ,
96 . rot(9) )
97 CALL inv3(rot,roti)
98C---
99 s=crst(1,ii)
100 t=crst(2,ii)
101 CALL i2_fform(
102 . nir,s,t,h,hh,hrs,hrt,hps,hpt,hprs,hprt,
103 . hxs,hxt,ls1,ls2,lt1,lt2,ls,lt)
104C
105 sumhrs = abs(hrs(1) +hrs(2) +hrs(3) +hrs(4))
106 sumhrt = abs(hrt(1) +hrt(2) +hrt(3) +hrt(4))
107 sumhprs = abs(hprs(1)+hprs(2)+hprs(3)+hprs(4))
108 sumhprt = abs(hprt(1)+hprt(2)+hprt(3)+hprt(4))
109 i1 = inod(1)
110 i2 = inod(2)
111 i3 = inod(3)
112 i4 = inod(4)
113 xc = x(1,i1)*h(1)+x(1,i2)*h(2)+x(1,i3)*h(3)+x(1,i4)*h(4)
114 yc = x(2,i2)*h(1)+x(2,i2)*h(2)+x(2,i3)*h(3)+x(2,i4)*h(4)
115 zc = x(3,i3)*h(1)+x(3,i2)*h(2)+x(3,i3)*h(3)+x(3,i4)*h(4)
116C
117 fs(1) = a(1,is)
118 fs(2) = a(2,is)
119 fs(3) = a(3,is)
120 moms(1) = ar(1,is)
121 moms(2) = ar(2,is)
122 moms(3) = ar(3,is)
123 xms = ms(is)
124 ins = in(is)
125 stfn=stifn(is)
126 stfr=stifr(is)
127C
128C--- secnd forces -> rep local
129C
130 fsloc(1) = rot(1)*fs(1) + rot(4)*fs(2) + rot(7)*fs(3)
131 fsloc(2) = rot(2)*fs(1) + rot(5)*fs(2) + rot(8)*fs(3)
132 fsloc(3) = rot(3)*fs(1) + rot(6)*fs(2) + rot(9)*fs(3)
133 fsloc(4) = rot(1)*moms(1) + rot(4)*moms(2) + rot(7)*moms(3)
134 fsloc(5) = rot(2)*moms(1) + rot(5)*moms(2) + rot(8)*moms(3)
135 fsloc(6) = rot(3)*moms(1) + rot(6)*moms(2) + rot(9)*moms(3)
136C
137C------- transfer secnd forces to main
138 DO jj=1,nir
139 fmloc(jj,1) = h(jj)*fsloc(1)
140 fmloc(jj,2) = h(jj)*fsloc(2)
141 fmloc(jj,3) = hh(jj)*fsloc(3)
142 . + hps(jj)*fsloc(4) + hpt(jj)*fsloc(5)
143 fmloc(jj,4) = hrs(jj)*fsloc(3)
144 . + hprs(jj)*fsloc(4)+ hxt(jj)*fsloc(5)
145 fmloc(jj,5) = hrt(jj)*fsloc(3)
146 . + hxs(jj)*fsloc(4) + hprt(jj)*fsloc(5)
147 fmloc(jj,6) = h(jj)*fsloc(6)
148 ENDDO
149C------- transfer secnd mass + inertia + stiffness to main
150 DO jj=1,nir
151 im = inod(jj)
152 len = sqrt((x(1,im)-xc)**2+(x(2,im)-yc)**2+(x(3,im)-zc)**2)
153C
154 dm1 = h(jj) *xms
155 dm2 = hh(jj)*xms
156 . + hh(jj)*(sumhrs +sumhrt)*xms/len
157 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*ins/len
158 IF (dm1 > dm2) THEN
159 dm(jj) = dm1
160 dstfn(jj) = h(jj)*stfn
161 ELSE
162 dm(jj) = dm2
163 dstfn(jj) = hh(jj)*stfn
164 . + hh(jj)*(sumhrs +sumhrt)*stfn/len
165 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*stfr/len
166 ENDIF
167C
168 din1 = abs(hrs(jj))*(sumhrs+sumhrt)*xms
169 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*ins
170 . + abs(hrs(jj))*xms*len
171 din2 = abs(hrt(jj))*(sumhrs+sumhrt)*xms
172 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*ins
173 . + abs(hrt(jj))*xms*len
174 din3 = h(jj)*ins
175 IF (din1 >= din2 .AND. din1 >= din3) THEN
176 din(jj) = din1
177 dstfr(jj) = abs(hrs(jj))*(sumhrs+sumhrt)*stfn
178 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*stfr
179 . + abs(hrs(jj))*stfn*len
180 ELSEIF (din2 >= din1 .AND. din2 >= din3) THEN
181 din(jj) = din2
182 dstfr(jj) = abs(hrt(jj))*(sumhrs+sumhrt)*stfn
183 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*stfr
184 . + abs(hrt(jj))*stfn*len
185 ELSEIF (din3 >= din1 .AND. din3 >= din2) THEN
186 din(jj) = din3
187 dstfr(jj) = h(jj)*stfr
188 ENDIF
189 ENDDO
190C
191C--- update main forces in global frame
192C
193 DO jj=1,4
194 fx(jj) = roti(1)*fmloc(jj,1)+roti(4)*fmloc(jj,2)+roti(7)*fmloc(jj,3)
195 fy(jj) = roti(2)*fmloc(jj,1)+roti(5)*fmloc(jj,2)+roti(8)*fmloc(jj,3)
196 fz(jj) = roti(3)*fmloc(jj,1)+roti(6)*fmloc(jj,2)+roti(9)*fmloc(jj,3)
197 ENDDO
198C
199 i0 = i0 + 1
200 jj = 1
201 nn = iadi2(jj,i0)
202
203 fskyi2(1,nn) = fx(jj)
204 fskyi2(2,nn) = fy(jj)
205 fskyi2(3,nn) = fz(jj)
206 fskyi2(4,nn) = dm(jj)
207 fskyi2(5,nn) = dstfn(jj)
208 fskyi2(6,nn) =
209 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
210 fskyi2(7,nn) =
211 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
212 fskyi2(8,nn) =
213 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
214 fskyi2(9,nn) = din(jj)
215 fskyi2(10,nn)= dstfr(jj)
216C
217 jj = 2
218 nn = iadi2(jj,i0)
219 fskyi2(1,nn) = fx(jj)
220 fskyi2(2,nn) = fy(jj)
221 fskyi2(3,nn) = fz(jj)
222 fskyi2(4,nn) = dm(jj)
223 fskyi2(5,nn) = dstfn(jj)
224 fskyi2(6,nn) =
225 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
226 fskyi2(7,nn) =
227 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
228 fskyi2(8,nn) =
229 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
230 fskyi2(9,nn) = din(jj)
231 fskyi2(10,nn)= dstfr(jj)
232C
233 jj = 3
234 nn = iadi2(jj,i0)
235 fskyi2(1,nn) = fx(jj)
236 fskyi2(2,nn) = fy(jj)
237 fskyi2(3,nn) = fz(jj)
238 fskyi2(4,nn) = dm(jj)
239 fskyi2(5,nn) = dstfn(jj)
240 fskyi2(6,nn) =
241 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
242 fskyi2(7,nn) =
243 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
244 fskyi2(8,nn) =
245 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
246 fskyi2(9,nn) = din(jj)
247 fskyi2(10,nn)= dstfr(jj)
248C
249 jj = 4
250 nn = iadi2(jj,i0)
251 fskyi2(1,nn) = fx(jj)
252 fskyi2(2,nn) = fy(jj)
253 fskyi2(3,nn) = fz(jj)
254 fskyi2(4,nn) = dm(jj)
255 fskyi2(5,nn) = dstfn(jj)
256 fskyi2(6,nn) =
257 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
258 fskyi2(7,nn) =
259 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
260 fskyi2(8,nn) =
261 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
262 fskyi2(9,nn) = din(jj)
263 fskyi2(10,nn)= dstfr(jj)
264C
265C--- output of tied contact forces
266 CALL i2forces(x ,fs ,fx ,fy ,fz ,
267 . inod(1) ,nir ,fsav ,fncont ,fncontp,
268 . ftcontp ,weight ,h3d_data,is ,h)
269C---
270 IF (idel2/=0.AND.ms(is)/=zero) smass(ii)=ms(is)
271 IF (idel2/=0.AND.ms(is)/=zero) siner(ii)=in(is)
272 stifr(is)=em20
273 stifn(is)=em20
274 in(is) =zero
275 ms(is) =zero
276 a(1,is) =zero
277 a(2,is) =zero
278 a(3,is) =zero
279 ar(1,is) =zero
280 ar(2,is) =zero
281 ar(3,is) =zero
282C---
283 ENDIF
284 ELSEIF(weight(-is) == 1) THEN
285C stokage ZERO pour noeuds delete par idel2
286 i0 = i0 + 1
287 nn = iadi2(1,i0)
288 fskyi2(1,nn) = zero
289 fskyi2(2,nn) = zero
290 fskyi2(3,nn) = zero
291 fskyi2(4,nn) = zero
292 fskyi2(5,nn) = zero
293 fskyi2(6,nn) = zero
294 fskyi2(7,nn) = zero
295 fskyi2(8,nn) = zero
296 fskyi2(9,nn) = zero
297 fskyi2(10,nn)= zero
298 nn = iadi2(2,i0)
299 fskyi2(1,nn) = zero
300 fskyi2(2,nn) = zero
301 fskyi2(3,nn) = zero
302 fskyi2(4,nn) = zero
303 fskyi2(5,nn) = zero
304 fskyi2(6,nn) = zero
305 fskyi2(7,nn) = zero
306 fskyi2(8,nn) = zero
307 fskyi2(9,nn) = zero
308 fskyi2(10,nn)= zero
309 nn = iadi2(3,i0)
310 fskyi2(1,nn) = zero
311 fskyi2(2,nn) = zero
312 fskyi2(3,nn) = zero
313 fskyi2(4,nn) = zero
314 fskyi2(5,nn) = zero
315 fskyi2(6,nn) = zero
316 fskyi2(7,nn) = zero
317 fskyi2(8,nn) = zero
318 fskyi2(9,nn) = zero
319 fskyi2(10,nn)= zero
320 nn = iadi2(4,i0)
321 fskyi2(1,nn) = zero
322 fskyi2(2,nn) = zero
323 fskyi2(3,nn) = zero
324 fskyi2(4,nn) = zero
325 fskyi2(5,nn) = zero
326 fskyi2(6,nn) = zero
327 fskyi2(7,nn) = zero
328 fskyi2(8,nn) = zero
329 fskyi2(9,nn) = zero
330 fskyi2(10,nn)= zero
331 ENDIF
332 ENDDO
333C-----------
334 RETURN
335 END
i2_fform
subroutine i2_fform(nir, s, t, h, hh, hrs, hrt, hps, hpt, hprs, hprt, hxs, hxt, ls1, ls2, lt1, lt2, ls, lt)
Definition i2_fform.F:33
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
i2curvfp
subroutine i2curvfp(ms, in, x, v, vr, a, ar, stifn, stifr, weight, nsv, msr, irtl, irect, crst, nsn, nmn, idel2, i0, i2size, iadi2, mmass, smass, siner, fskyi2, fsav, fncont, h3d_data, fncontp, ftcontp)
Definition i2curvfp.F:42
i2forces
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)
Definition i2forces.F:52
inv3
subroutine inv3(a, b)
Definition inv3.F:29
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
h3d_mod::h3d_database
Definition h3d_mod.F:435