OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3_e2s.F File Reference
#include "implicit_f.inc"
#include "assert.inc"
#include "mvsiz_p.inc"
#include "i25edge_c.inc"
#include "param_c.inc"
#include "sms_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i25cor3_e2s()

subroutine i25cor3_e2s ( integer jlt,
integer, dimension(nledge,*) ledge,
integer, dimension(4,*) irect,
x,
v,
integer, dimension(*) cand_s,
integer, dimension(*) 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,
integer, dimension(4,mvsiz) n1,
integer, dimension(4,mvsiz) n2,
integer, dimension(4,mvsiz) m1,
integer, dimension(4,mvsiz) m2,
integer nedge,
integer nin,
stfac,
integer, dimension(*) nodnx_sms,
integer, dimension(4,mvsiz) nsms,
gape,
gapve,
integer iedge,
integer, dimension(4,*) admsr,
integer, dimension(*) lbound,
real*4, dimension(3,4,*) edg_bisector,
real*4, dimension(3,2,*) vtx_bisector,
integer, dimension(mvsiz) typedgs,
integer, dimension(mvsiz) ias,
integer, dimension(mvsiz) jas,
integer, dimension(mvsiz) ibs,
integer, dimension(mvsiz) jbs,
integer, dimension(mvsiz) iam,
stfe,
integer, dimension(2,4*mvsiz) edge_id,
integer, dimension(*) itab,
integer intfric,
integer, dimension(*) ipartfric_e,
integer, dimension(4,mvsiz) ipartfric_es,
integer, dimension(4,mvsiz) ipartfric_em,
integer, intent(in) igsti,
intent(in) kmin,
intent(in) kmax,
real*4, dimension(3,nadmsr), intent(in) e2s_nod_normal,
integer, intent(in) nadmsr,
dimension(3,mvsiz), intent(inout) normaln1,
dimension(3,mvsiz), intent(inout) normaln2,
dimension(3,4,mvsiz), intent(inout) normalm1,
dimension(3,4,mvsiz), intent(inout) normalm2,
integer, intent(in) istif_msdt,
intent(in) dtstif,
dimension(nedge), intent(in) stifmsdt_edg,
dimension(nrtm), intent(in) stifmsdt_m,
integer, intent(in) nrtm,
type (parameters_), intent(in) parameters )

Definition at line 35 of file i25cor3_e2s.F.

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
62 USE parameters_mod
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
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
debug_mod
Definition debug_mod.F:45
debug_mod::int_checksum
pure integer function int_checksum(a, siz1, siz2)
Definition debug_mod.F:167
parameters_mod
Definition parameters_mod.F:49
tri25ebox::edg_bisector_fie
type(real4_pointer3), dimension(:), allocatable edg_bisector_fie
Definition tri25ebox.F:83
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:88
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
tri7box::vfie
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
tri7box::ipartfric_fie
type(int_pointer), dimension(:), allocatable ipartfric_fie
Definition tri7box.F:440
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::nodnxfie
type(int_pointer), dimension(:), allocatable nodnxfie
Definition tri7box.F:440
tri7box::stife_msdt_fi
type(real_pointer), dimension(:), allocatable stife_msdt_fi
Definition tri7box.F:553
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449