OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3_e2s.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!|| i25cor3_e2s ../engine/source/interfaces/int25/i25cor3_e2s.f
25!||--- called by ------------------------------------------------------
26!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
27!||--- calls -----------------------------------------------------
28!|| int_checksum ../engine/share/modules/debug_mod.F
29!||--- uses -----------------------------------------------------
30!|| debug_mod ../engine/share/modules/debug_mod.F
31!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.f
32!|| tri25ebox ../engine/share/modules/tri25ebox.F
33!|| tri7box ../engine/share/modules/tri7box.F
34!||====================================================================
35 SUBROUTINE i25cor3_e2s(
36 1 JLT ,LEDGE ,IRECT ,X ,V ,
37 2 CAND_S ,CAND_M ,STFM ,MS ,EX ,
38 3 EY ,EZ ,FX ,FY ,FZ ,
39 4 STIF ,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
40 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
41 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
42 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
43 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
44 9 MS1 ,MS2 ,MM1 ,MM2 ,N1 ,
45 A N2 ,M1 ,M2 ,NEDGE ,NIN ,
46 C STFAC ,NODNX_SMS,NSMS ,GAPE ,GAPVE ,
47 D IEDGE ,ADMSR ,LBOUND ,EDG_BISECTOR ,
48 E VTX_BISECTOR,TYPEDGS,IAS ,JAS ,IBS ,
49 F JBS ,IAM ,STFE , EDGE_ID, ITAB ,
50 G INTFRIC,IPARTFRIC_E,IPARTFRIC_ES,IPARTFRIC_EM,
51 H IGSTI ,KMIN ,KMAX ,E2S_NOD_NORMAL,NADMSR,
52 I NORMALN1,NORMALN2,NORMALM1,NORMALM2,ISTIF_MSDT,
53 J DTSTIF,STIFMSDT_EDG,STIFMSDT_M,NRTM,PARAMETERS)
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE tri25ebox
58 USE tri7box
59#ifdef WITH_ASSERT
60 USE debug_mod
61#endif
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67#include "assert.inc"
68C-----------------------------------------------
69C G l o b a l P a r a m e t e r s
70C-----------------------------------------------
71#include "mvsiz_p.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "i25edge_c.inc"
76#include "param_c.inc"
77#include "sms_c.inc"
78#include "task_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 INTEGER :: ITAB(*)
83 INTEGER :: EDGE_ID(2,4*MVSIZ)
84 INTEGER :: INTFRIC ,IPARTFRIC_E(*),IPARTFRIC_ES(4,MVSIZ),IPARTFRIC_EM(4,MVSIZ)
85 INTEGER LEDGE(NLEDGE,*), IRECT(4,*), CAND_M(*), CAND_S(*), ADMSR(4,*),
86 . LBOUND(*), JLT, NEDGE, NIN, IEDGE,
87 . N1(4,MVSIZ), N2(4,MVSIZ),
88 . M1(4,MVSIZ), M2(4,MVSIZ),
89 . NODNX_SMS(*), NSMS(4,MVSIZ),
90 . TYPEDGS(MVSIZ),IAS(MVSIZ),JAS(MVSIZ),IBS(MVSIZ),JBS(MVSIZ),IAM(MVSIZ)
91 INTEGER , INTENT(IN) :: IGSTI, NADMSR
92 INTEGER , INTENT(IN) :: ISTIF_MSDT
93 INTEGER , INTENT(IN) :: NRTM
94C REAL
95 my_real
96 . X(3,*), STFM(*), STFE(*), MS(*), V(3,*),
97 . XXS1(4,MVSIZ), XXS2(4,MVSIZ), XYS1(4,MVSIZ), XYS2(4,MVSIZ),
98 . XZS1(4,MVSIZ), XZS2(4,MVSIZ), XXM1(4,MVSIZ), XXM2(4,MVSIZ),
99 . XYM1(4,MVSIZ), XYM2(4,MVSIZ), XZM1(4,MVSIZ), XZM2(4,MVSIZ),
100 . vxs1(4,mvsiz), vxs2(4,mvsiz), vys1(4,mvsiz), vys2(4,mvsiz),
101 . vzs1(4,mvsiz), vzs2(4,mvsiz), vxm1(4,mvsiz), vxm2(4,mvsiz),
102 . vym1(4,mvsiz), vym2(4,mvsiz), vzm1(4,mvsiz), vzm2(4,mvsiz),
103 . ms1(4,mvsiz), ms2(4,mvsiz), mm1(4,mvsiz), mm2(4,mvsiz),
104 . stif(4,mvsiz),stfac,sts,stm,
105 . gape(*) ,gapve(4,mvsiz),
106 . ex(4,mvsiz), ey(4,mvsiz), ez(4,mvsiz), fx(mvsiz), fy(mvsiz), fz(mvsiz)
107 real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
108 my_real , INTENT(IN) :: kmin, kmax
109 real*4 , INTENT(IN) :: e2s_nod_normal(3,nadmsr)
110 my_real , INTENT(INOUT) :: normaln1(3,mvsiz),normaln2(3,mvsiz),
111 . normalm1(3,4,mvsiz),normalm2(3,4,mvsiz)
112 my_real , INTENT(IN) :: dtstif
113 my_real , INTENT(IN) :: stifmsdt_edg(nedge) , stifmsdt_m(nrtm)
114 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER I ,NN, J, JRM, K, KRM, I1, J1, I2, J2, EJ,
119 . IE, JE, SOL_EDGE, SH_EDGE, ES, IS(MVSIZ)
120C INTEGER :: NOD1S(MVSIZ),NOD2S(MVSIZ)
121C INTEGER :: NOD1M(MVSIZ),NOD2M(MVSIZ)
122
123 my_real
124 . AAA, DX, DY, DZ, DD, NNI, NI2, INVCOS, DTS
125 my_real
126 . gape_m(mvsiz), gape_s(mvsiz), stif_msdt(mvsiz)
127 INTEGER :: IDS(4)
128C-----------------------------------------------
129
130 edge_id(1:2,1:4*mvsiz) = -666
131 DO i=1,jlt
132
133 iam(i)=cand_m(i)
134
135 stm=stfm(iam(i))
136
137#ifdef WITH_ASSERT
138C definition of an ID for the edge using hash table
139C used for debug only
140C using -DWITH_ASSERT will make IDs unique
141C whatever the number of domains
142 ids(1) = itab(irect(1,iam(i)))
143 ids(2) = itab(irect(2,iam(i)))
144 ids(3) = itab(irect(3,iam(i)))
145 ids(4) = itab(irect(4,iam(i)))
146 edge_id(1,i) = int_checksum(ids,4,1)
147#else
148C by default, the ID is local to each domain
149 edge_id(1,i) = i
150#endif
151
152 DO ej=1,4
153 m1(ej,i)=irect(ej,iam(i))
154 m2(ej,i)=irect(mod(ej,4)+1,iam(i))
155
156 xxm1(ej,i) = x(1,m1(ej,i))
157 xym1(ej,i) = x(2,m1(ej,i))
158 xzm1(ej,i) = x(3,m1(ej,i))
159 xxm2(ej,i) = x(1,m2(ej,i))
160 xym2(ej,i) = x(2,m2(ej,i))
161 xzm2(ej,i) = x(3,m2(ej,i))
162 vxm1(ej,i) = v(1,m1(ej,i))
163 vym1(ej,i) = v(2,m1(ej,i))
164 vzm1(ej,i) = v(3,m1(ej,i))
165 vxm2(ej,i) = v(1,m2(ej,i))
166 vym2(ej,i) = v(2,m2(ej,i))
167 vzm2(ej,i) = v(3,m2(ej,i))
168 mm1(ej,i) = ms(m1(ej,i))
169 mm2(ej,i) = ms(m2(ej,i))
170C
171 IF(cand_s(i)<=nedge) THEN
172
173 es =cand_s(i)
174 ias(i)=abs(ledge(1,es))
175 jas(i)=ledge(2,es)
176 ibs(i)=ledge(3,es)
177 jbs(i)=ledge(4,es)
178 n1(ej,i)=ledge(5,es)
179 n2(ej,i)=ledge(6,es)
180C NOD1S(I) = LEDGE(11,ES)
181C NOD2S(I) = LEDGE(12,ES)
182 is(i) = ledge(10,es)
183 edge_id(2,i) = ledge(8,es)
184
185C IF(IRECT(JAS(I),IAS(I))==N1(EJ,I).AND.IRECT(MOD(JAS(I),4)+1,IAS(I))==N2(EJ,I))THEN
186C IS(I)= 1
187C ELSEIF(IRECT(JAS(I),IAS(I))==N2(EJ,I).AND.IRECT(MOD(JAS(I),4)+1,IAS(I))==N1(EJ,I))THEN
188C IS(I)=-1
189C ELSE
190C print *,'i25cor3_e2s - internal problem',ES,N1(EJ,I),N2(EJ,I),
191C . IRECT(JAS(I),IAS(I)),IRECT(MOD(JAS(I),4)+1,IAS(I))
192C END IF
193
194 sts=stfe(es)
195 stif(ej,i)=sts*stm / max(em20,sts+stm)
196c STIF(EJ,I)=MAX(KMIN,MIN(STIF(EJ,I),KMAX))
197
198 xxs1(ej,i) = x(1,n1(ej,i))
199 xys1(ej,i) = x(2,n1(ej,i))
200 xzs1(ej,i) = x(3,n1(ej,i))
201 xxs2(ej,i) = x(1,n2(ej,i))
202 xys2(ej,i) = x(2,n2(ej,i))
203 xzs2(ej,i) = x(3,n2(ej,i))
204 vxs1(ej,i) = v(1,n1(ej,i))
205 vys1(ej,i) = v(2,n1(ej,i))
206 vzs1(ej,i) = v(3,n1(ej,i))
207 vxs2(ej,i) = v(1,n2(ej,i))
208 vys2(ej,i) = v(2,n2(ej,i))
209 vzs2(ej,i) = v(3,n2(ej,i))
210 ms1(ej,i) = ms(n1(ej,i))
211 ms2(ej,i) = ms(n2(ej,i))
212C
213 typedgs(i)=ledge(7,es)
214C
215 ELSE
216 nn = cand_s(i) - nedge
217 is(i) = ledge_fie(nin)%P(e_im,nn)
218 n1(ej,i)=2*(nn-1)+1
219 n2(ej,i)=2*nn
220
221
222 edge_id(2,i) = ledge_fie(nin)%P(e_global_id,nn)
223
224c STS=STFE(CAND_S(I))
225c STIF(I)=STS*STM / MAX(EM20,STS+STM)
226c STIF(I)=ABS(STIFIE(NIN)%P(NN))*STM
227c / MAX(EM20,ABS(STIFIE(NIN)%P(NN))+STM)
228c
229c TYPEDGS(I)=LEDGE(7,CAND_S(I))
230c
231 sts=stifie(nin)%P(nn)
232 stif(ej,i)=sts*stm / max(em20,sts+stm)
233
234c STIF(EJ,I)=MAX(KMIN,MIN(STIF(EJ,I),KMAX))
235
236 typedgs(i)=ledge_fie(nin)%P(e_type,nn)
237
238 ias(i)=abs(ledge_fie(nin)%P(e_left_seg ,nn))
239 jas(i)=ledge_fie(nin)%P(e_left_id ,nn)
240 ibs(i)=ledge_fie(nin)%P(e_right_seg ,nn)
241 jbs(i)=ledge_fie(nin)%P(e_right_id ,nn)
242
243
244 xxs1(ej,i) = xfie(nin)%P(1,n1(ej,i))
245 xys1(ej,i) = xfie(nin)%P(2,n1(ej,i))
246 xzs1(ej,i) = xfie(nin)%P(3,n1(ej,i))
247 xxs2(ej,i) = xfie(nin)%P(1,n2(ej,i))
248 xys2(ej,i) = xfie(nin)%P(2,n2(ej,i))
249 xzs2(ej,i) = xfie(nin)%P(3,n2(ej,i))
250 vxs1(ej,i) = vfie(nin)%P(1,n1(ej,i))
251 vys1(ej,i) = vfie(nin)%P(2,n1(ej,i))
252 vzs1(ej,i) = vfie(nin)%P(3,n1(ej,i))
253 vxs2(ej,i) = vfie(nin)%P(1,n2(ej,i))
254 vys2(ej,i) = vfie(nin)%P(2,n2(ej,i))
255 vzs2(ej,i) = vfie(nin)%P(3,n2(ej,i))
256 ms1(ej,i) = msfie(nin)%P(n1(ej,i))
257 ms2(ej,i) = msfie(nin)%P(n2(ej,i))
258C
259 END IF
260 END DO
261 END DO
262C------------------------------------------
263C Stiffness based on mass and time step
264C------------------------------------------
265
266 IF(istif_msdt > 0) THEN
267 IF(dtstif > zero) THEN
268 dts = dtstif
269 ELSE
270 dts = parameters%DT_STIFINT
271 ENDIF
272 DO i=1,jlt
273
274 IF(cand_s(i)<=nedge) THEN
275 es =cand_s(i)
276 stif_msdt(i) = stifmsdt_edg(es)
277 ELSE
278 nn = cand_s(i) - nedge
279 stif_msdt(i) = abs(stife_msdt_fi(nin)%P(nn))
280 ENDIF
281 stif_msdt(i) = stifmsdt_m(iam(i))*stif_msdt(i)/(stifmsdt_m(iam(i))+stif_msdt(i))
282
283 stif_msdt(i) = stif_msdt(i)/(dts*dts)
284 DO ej=1,4
285 stif(ej,i)=max(stif(ej,i),stif_msdt(i))
286 ENDDO
287 ENDDO
288 ENDIF
289C
290 DO i=1,jlt
291 DO ej=1,4
292 stif(ej,i)=max(kmin,min(stif(ej,i),kmax))
293 ENDDO
294 ENDDO
295
296C
297C THIS is provisional (solids => Zero gap even if secnd shell edge)
298 DO i=1,jlt
299 gape_m(i)=zero ! Solids
300 ! If edge is shared by solid and shell : edge is considered as a shell edge
301 IF(cand_s(i)<=nedge) THEN
302 gape_s(i)=gape(cand_s(i))
303 ELSE ! TBD
304 gape_s(i)= gapfie(nin)%P(cand_s(i) - nedge)
305 END IF
306 gapve(1:4,i)=zero
307 END DO
308
309 sol_edge=iedge/10 ! solids
310 sh_edge =iedge-10*sol_edge ! shells
311
312 DO i=1,jlt
313 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es, stfm(iam(i)))
314
315 IF ( stfm(iam(i)) > zero) THEN
316 DO ej=1,4
317C Comment savoir si EDG_BiSECTOR a ete calcule
318 ex(ej,i)=edg_bisector(1,ej,iam(i))
319 ey(ej,i)=edg_bisector(2,ej,iam(i))
320 ez(ej,i)=edg_bisector(3,ej,iam(i))
321 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,ex(ej,i))
322 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,ey(ej,i))
323 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,ez(ej,i))
324 END DO
325 ELSE
326 ex(1:4,i) = zero
327 ey(1:4,i) = zero
328 ez(1:4,i) = zero
329 debug_e2e(edge_id(1,i)==d_em .AND. edge_id(2,i) == d_es,zero)
330 END IF
331 END DO
332
333C
334 DO i=1,jlt
335 IF(cand_s(i)<=nedge) THEN
336 fx(i) = edg_bisector(1,jas(i),ias(i))
337 fy(i) = edg_bisector(2,jas(i),ias(i))
338 fz(i) = edg_bisector(3,jas(i),ias(i))
339 ELSE
340 fx(i) = edg_bisector_fie(nin)%P(1,1,cand_s(i)-nedge)
341 fy(i) = edg_bisector_fie(nin)%P(2,1,cand_s(i)-nedge)
342 fz(i) = edg_bisector_fie(nin)%P(3,1,cand_s(i)-nedge)
343 END IF
344 END DO
345
346C
347 nsms(1:4,1:mvsiz) = -666
348 IF(idtmins==2)THEN
349 DO i=1,jlt
350 IF(cand_s(i)<=nedge)THEN
351 DO ej=1,4
352 nsms(ej,i)=nodnx_sms(n1(ej,i))+nodnx_sms(n2(ej,i))+
353 . nodnx_sms(m1(ej,i))+nodnx_sms(m2(ej,i))
354 debug_e2e(nsms(ej,i) < 0,nodnx_sms(n1(ej,i)))
355 debug_e2e(nsms(ej,i) < 0,nodnx_sms(n2(ej,i)))
356
357 END DO
358 ELSE
359 DO ej=1,4
360 nsms(ej,i)=nodnxfie(nin)%P(n1(ej,i))+nodnxfie(nin)%P(n2(ej,i))+
361 . nodnx_sms(m1(ej,i))+nodnx_sms(m2(ej,i))
362 debug_e2e(nsms(ej,i) < 0,nodnxfie(nin)%P(n1(ej,i)))
363 debug_e2e(nsms(ej,i) < 0,nodnxfie(nin)%P(n2(ej,i)))
364 END DO
365 END IF
366 ENDDO
367
368 IF(idtmins_int/=0)THEN
369 DO i=1,jlt
370 DO ej=1,4
371 IF(nsms(ej,i)==0)nsms(ej,i)=-1
372 ENDDO
373 ENDDO
374 END IF
375 ELSEIF(idtmins_int/=0)THEN
376 DO i=1,jlt
377 DO ej=1,4
378 nsms(ej,i)=-1
379 ENDDO
380 ENDDO
381 ENDIF
382C
383C----Friction model : secnd part IDs---------
384 IF(intfric > 0) THEN
385 DO i=1,jlt
386
387 IF(cand_s(i)<=nedge)THEN
388 ipartfric_es(1:4,i) = ipartfric_e(cand_s(i))
389 ELSE
390 nn = cand_s(i) - nedge
391 ipartfric_es(1:4,i)= ipartfric_fie(nin)%P(nn)
392 ENDIF
393C
394 ipartfric_em(1:4,i) = ipartfric_e(cand_m(i))
395 ENDDO
396 ENDIF
397C-------Normal nodes ---------
398 IF(sol_edge/=0)THEN
399 DO i=1,jlt
400 IF(typedgs(i)/=1)cycle
401 DO ej=1,4
402 normalm1(1:3,ej,i)=e2s_nod_normal(1:3,admsr(ej,iam(i)))
403 normalm2(1:3,ej,i)=e2s_nod_normal(1:3,admsr(mod(ej,4)+1,iam(i)))
404 ENDDO
405 IF(cand_s(i)<=nedge)THEN
406 IF(is(i) == 1 ) THEN
407 normaln1(1:3,i)=e2s_nod_normal(1:3,admsr(jas(i),ias(i)))
408 normaln2(1:3,i)=e2s_nod_normal(1:3,admsr(mod(jas(i),4)+1,ias(i)))
409 ELSE
410 normaln2(1:3,i)=e2s_nod_normal(1:3,admsr(jas(i),ias(i)))
411 normaln1(1:3,i)=e2s_nod_normal(1:3,admsr(mod(jas(i),4)+1,ias(i)))
412 ENDIF
413 ELSE
414 IF(is(i) == 1 ) THEN
415 normaln1(1:3,i)=edg_bisector_fie(nin)%P(1:3,2,cand_s(i) - nedge)
416 normaln2(1:3,i)=edg_bisector_fie(nin)%P(1:3,3,cand_s(i) - nedge)
417 ELSE
418 normaln2(1:3,i)=edg_bisector_fie(nin)%P(1:3,2,cand_s(i) - nedge)
419 normaln1(1:3,i)=edg_bisector_fie(nin)%P(1:3,3,cand_s(i) - nedge)
420 ENDIF
421 ENDIF
422
423 ENDDO
424 ENDIF
425 RETURN
426 END
subroutine i25cor3_e2s(jlt, ledge, irect, x, v, cand_s, cand_m, stfm, ms, ex, ey, ez, fx, fy, fz, stif, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, n1, n2, m1, m2, nedge, nin, stfac, nodnx_sms, nsms, gape, gapve, iedge, admsr, lbound, edg_bisector, vtx_bisector, typedgs, ias, jas, ibs, jbs, iam, stfe, edge_id, itab, intfric, ipartfric_e, ipartfric_es, ipartfric_em, igsti, kmin, kmax, e2s_nod_normal, nadmsr, normaln1, normaln2, normalm1, normalm2, istif_msdt, dtstif, stifmsdt_edg, stifmsdt_m, nrtm, parameters)
Definition i25cor3_e2s.F:54
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
pure integer function int_checksum(a, siz1, siz2)
Definition debug_mod.F:167
type(real4_pointer3), dimension(:), allocatable edg_bisector_fie
Definition tri25ebox.F:83
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:88
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
type(int_pointer), dimension(:), allocatable ipartfric_fie
Definition tri7box.F:440
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
type(int_pointer), dimension(:), allocatable nodnxfie
Definition tri7box.F:440
type(real_pointer), dimension(:), allocatable stife_msdt_fi
Definition tri7box.F:553
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449