OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10cumu3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s10cumu3 (offg, a, nc, stifn, sti, fx, fy, fz, deltax2, them, fthe, ar, x, stifr, sav, condn, conde, itagdn, nel, ismstr, jthe, isrot, nodadt_therm)

Function/Subroutine Documentation

◆ s10cumu3()

subroutine s10cumu3 ( offg,
a,
integer, dimension(mvsiz,10) nc,
stifn,
sti,
fx,
fy,
fz,
deltax2,
them,
fthe,
ar,
x,
stifr,
double precision, dimension(nel,30) sav,
condn,
conde,
integer, dimension(*) itagdn,
integer nel,
integer, intent(in) ismstr,
integer, intent(in) jthe,
integer, intent(in) isrot,
integer, intent(in) nodadt_therm )

Definition at line 28 of file s10cumu3.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43#include "com04_c.inc"
44#include "scr17_c.inc"
45#include "scr18_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER, INTENT(IN) :: ISMSTR
50 INTEGER, INTENT(IN) :: JTHE
51 INTEGER, INTENT(IN) :: ISROT
52 INTEGER, INTENT(IN) :: NODADT_THERM
53 INTEGER NC(MVSIZ,10),ITAGDN(*),NEL
54C REAL
55 my_real
56 . offg(*),a(3,*),stifn(*),sti(*),deltax2(*),
57 . fx(mvsiz,10), fy(mvsiz,10), fz(mvsiz,10),
58 . them(mvsiz,10),fthe(*),ar(3,*),x(3,*),stifr(*),
59 . condn(*),conde(*)
60 double precision
61 . sav(nel,30)
62 my_real
63 . stiv(mvsiz),stie(mvsiz)
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,N, IPERM(4),IPERM1(10),IPERM2(10),N1,N2,NN,ND,II,J
71C-----------------------------------------------
72 DATA iperm/1,3,6,5/
73 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
74 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
75 my_real
76 . off_l,xm,ym,zm,xx,yy,zz,facirot,facirot2
77C-----------------------------------------------
78c FACIROT = (7./48.) / (1./32/) ! rapport des masses
79 facirot = (nine + third)
80c FACIROT2 = TWO * (7./48.) / (1./32/) ! 2 * rapport des masses
81c FACIROT2 = NINE + THIRD
82 facirot2 = two * (nine + third)
83
84 off_l = 0.
85 DO i=1,nel
86 off_l = min(off_l,offg(i))
87 ENDDO
88 IF(off_l<zero)THEN
89 DO i=1,nel
90 IF(offg(i)<zero)THEN
91 fx(i,1:10)=zero
92 sti(i)=zero
93 ENDIF
94 ENDDO
95 ENDIF
96 IF(jthe < 0 ) THEN
97 IF(off_l<=zero)THEN
98 DO j=1,10
99 DO i=1,nel
100 IF(offg(i)<=zero)THEN
101 them(i,j)=zero
102 ENDIF
103 ENDDO
104 ENDDO
105 ENDIF
106 IF(nodadt_therm == 1) THEN
107 IF(off_l<zero)THEN
108 DO i=1,nel
109 IF(offg(i)<zero)THEN
110 conde(i)=zero
111 ENDIF
112 ENDDO
113 ENDIF
114 ENDIF
115 ENDIF
116C
117 IF(idt1tet10/=0 .AND. isrot/=1)THEN
118 IF(isrot==0)THEN
119 DO i=1,nel
120C
121C DELTAX/SSP = 2/Omega, Omega=SQRT[Spectral Radius(M-1 K)] cf s10deri3.F
122C = SQRT[Volp*Rho/Kp] cf mqviscb.F
123C STIG = sum(Kp) cf s10fint3.F
124C => STIG == sum( Volp*rho ) * Omega**2/4 == M * Omega**2/4
125C
126C cf Assembling respectively Kvertex=Mvertex * Omega**2/2 and Kedge=Medge * Omega**2/2
127 stiv(i) = two/thirty2 * sti(i)
128 stie(i) = two*seven/fourty8 * sti(i)
129 END DO
130C
131 DO n=1,4
132 DO i=1,nel
133 nn = nc(i,n)
134 a(1,nn)=a(1,nn)+fx(i,n)
135 a(2,nn)=a(2,nn)+fy(i,n)
136 a(3,nn)=a(3,nn)+fz(i,n)
137C Assembling Mvertex * Rayon(M-1 K)/2
138 stifn(nn)=stifn(nn)+stiv(i)
139 ENDDO
140 ENDDO
141
142 DO n=5,10
143 DO i=1,nel
144 nn = nc(i,n)
145 IF(nn/=0)THEN
146 a(1,nn)=a(1,nn)+fx(i,n)
147 a(2,nn)=a(2,nn)+fy(i,n)
148 a(3,nn)=a(3,nn)+fz(i,n)
149C Assembling Medge * Rayon(M-1 K)/2
150 stifn(nn)=stifn(nn)+stie(i)
151 ELSE
152 n1=nc(i,iperm1(n))
153 n2=nc(i,iperm2(n))
154 a(1,n1)=a(1,n1)+half*fx(i,n)
155 a(2,n1)=a(2,n1)+half*fy(i,n)
156 a(3,n1)=a(3,n1)+half*fz(i,n)
157 stifn(n1)=stifn(n1)+half*stie(i)
158 a(1,n2)=a(1,n2)+half*fx(i,n)
159 a(2,n2)=a(2,n2)+half*fy(i,n)
160 a(3,n2)=a(3,n2)+half*fz(i,n)
161 stifn(n2)=stifn(n2)+half*stie(i)
162 ENDIF
163 ENDDO
164 ENDDO
165
166 ELSE
167 DO i=1,nel
168C
169C DELTAX/SSP = 2/Omega, Omega=SQRT[Spectral Radius(K)/Mmin] with Mmin=M/4 cf s10deri3.F
170C = SQRT[Volp*Rho/Kp] cf mqviscb.F
171C STIG = sum(Kp) cf s10fint3.F
172C => STIG == sum( Volp*rho ) * Radius(K) / (4 Mmin) == Radius(K)
173 sti(i) = half * sti(i)
174 END DO
175
176 DO n=1,4
177 DO i=1,nel
178 nn = nc(i,n)
179 a(1,nn)=a(1,nn)+fx(i,n)
180 a(2,nn)=a(2,nn)+fy(i,n)
181 a(3,nn)=a(3,nn)+fz(i,n)
182 stifn(nn)=stifn(nn)+sti(i)
183 ENDDO
184 ENDDO
185
186 DO n=5,10
187 DO i=1,nel
188 nn = nc(i,n)
189 IF(nn == 0)THEN
190 n1=nc(i,iperm1(n))
191 n2=nc(i,iperm2(n))
192 a(1,n1)=a(1,n1)+half*fx(i,n)
193 a(2,n1)=a(2,n1)+half*fy(i,n)
194 a(3,n1)=a(3,n1)+half*fz(i,n)
195 a(1,n2)=a(1,n2)+half*fx(i,n)
196 a(2,n2)=a(2,n2)+half*fy(i,n)
197 a(3,n2)=a(3,n2)+half*fz(i,n)
198 ELSEIF(itagdn(nn)/=0) THEN
199C-----------will be done in resol
200 a(1,nn)=a(1,nn)+fx(i,n)
201 a(2,nn)=a(2,nn)+fy(i,n)
202 a(3,nn)=a(3,nn)+fz(i,n)
203 stifn(nn)=stifn(nn)+sti(i)*facirot
204 ENDIF
205 ENDDO
206 ENDDO
207 ENDIF
208
209 ELSE ! IF(IDT1TET10/=0 .AND. ISROT/=1)THEN
210C same as version 44./ to be checked
211 DO i=1,nel
212 sti(i)=fourth*sti(i)
213 END DO
214C
215 IF(isrot == 0)THEN
216 DO n=1,4
217 DO i=1,nel
218 nn = nc(i,n)
219 a(1,nn)=a(1,nn)+fx(i,n)
220 a(2,nn)=a(2,nn)+fy(i,n)
221 a(3,nn)=a(3,nn)+fz(i,n)
222 stifn(nn)=stifn(nn)+sti(i)*deltax2(i)
223 ENDDO
224 ENDDO
225
226 DO n=5,10
227 DO i=1,nel
228 nn = nc(i,n)
229 IF(nn/=0)THEN
230 a(1,nn)=a(1,nn)+fx(i,n)
231 a(2,nn)=a(2,nn)+fy(i,n)
232 a(3,nn)=a(3,nn)+fz(i,n)
233 stifn(nn)=stifn(nn)+sti(i)
234 ELSE
235 n1=nc(i,iperm1(n))
236 n2=nc(i,iperm2(n))
237 a(1,n1)=a(1,n1)+half*fx(i,n)
238 a(2,n1)=a(2,n1)+half*fy(i,n)
239 a(3,n1)=a(3,n1)+half*fz(i,n)
240 stifn(n1)=stifn(n1)+half*sti(i)
241 a(1,n2)=a(1,n2)+half*fx(i,n)
242 a(2,n2)=a(2,n2)+half*fy(i,n)
243 a(3,n2)=a(3,n2)+half*fz(i,n)
244 stifn(n2)=stifn(n2)+half*sti(i)
245 ENDIF
246 ENDDO
247 ENDDO
248
249 ELSEIF(isrot == 1)THEN
250
251 DO n=1,4
252 DO i=1,nel
253 nn = nc(i,n)
254 a(1,nn)=a(1,nn)+fx(i,n)
255 a(2,nn)=a(2,nn)+fy(i,n)
256 a(3,nn)=a(3,nn)+fz(i,n)
257 stifn(nn)=stifn(nn) + sti(i)*two
258 stifr(nn)=stifr(nn) + one_over_8*sti(i)*deltax2(i)*three
259 ENDDO
260 ENDDO
261
262 IF(ismstr==1.OR.((ismstr==2.OR.ismstr==12).AND.idtmin(1)==3))THEN
263 DO n=5,10
264 DO i=1,nel
265 n1=nc(i,iperm1(n))
266 n2=nc(i,iperm2(n))
267 a(1,n1)=a(1,n1)+half*fx(i,n)
268 a(2,n1)=a(2,n1)+half*fy(i,n)
269 a(3,n1)=a(3,n1)+half*fz(i,n)
270 a(1,n2)=a(1,n2)+half*fx(i,n)
271 a(2,n2)=a(2,n2)+half*fy(i,n)
272 a(3,n2)=a(3,n2)+half*fz(i,n)
273 IF(abs(offg(i))>one)THEN
274 xx=sav(i,iperm2(n))-sav(i,iperm1(n))
275 yy=sav(i,iperm2(n)+10)-sav(i,iperm1(n)+10)
276 zz=sav(i,iperm2(n)+20)-sav(i,iperm1(n)+20)
277 xm = one_over_8*(yy*fz(i,n) - zz*fy(i,n))
278 ym = one_over_8*(zz*fx(i,n) - xx*fz(i,n))
279 zm = one_over_8*(xx*fy(i,n) - yy*fx(i,n))
280 ELSE
281 xm = one_over_8*
282 . ((x(2,n2)-x(2,n1))*fz(i,n) - (x(3,n2)-x(3,n1))*fy(i,n))
283 ym = one_over_8*
284 . ((x(3,n2)-x(3,n1))*fx(i,n) - (x(1,n2)-x(1,n1))*fz(i,n))
285 zm = one_over_8*
286 . ((x(1,n2)-x(1,n1))*fy(i,n) - (x(2,n2)-x(2,n1))*fx(i,n))
287 END IF
288 ar(1,n1) = ar(1,n1) + xm
289 ar(2,n1) = ar(2,n1) + ym
290 ar(3,n1) = ar(3,n1) + zm
291 ar(1,n2) = ar(1,n2) - xm
292 ar(2,n2) = ar(2,n2) - ym
293 ar(3,n2) = ar(3,n2) - zm
294 END DO
295 END DO
296 ELSE
297 DO n=5,10
298 DO i=1,nel
299 n1=nc(i,iperm1(n))
300 n2=nc(i,iperm2(n))
301 a(1,n1)=a(1,n1)+half*fx(i,n)
302 a(2,n1)=a(2,n1)+half*fy(i,n)
303 a(3,n1)=a(3,n1)+half*fz(i,n)
304 a(1,n2)=a(1,n2)+half*fx(i,n)
305 a(2,n2)=a(2,n2)+half*fy(i,n)
306 a(3,n2)=a(3,n2)+half*fz(i,n)
307 xm = one_over_8*
308 . ((x(2,n2)-x(2,n1))*fz(i,n) - (x(3,n2)-x(3,n1))*fy(i,n))
309 ym = one_over_8*
310 . ((x(3,n2)-x(3,n1))*fx(i,n) - (x(1,n2)-x(1,n1))*fz(i,n))
311 zm = one_over_8*
312 . ((x(1,n2)-x(1,n1))*fy(i,n) - (x(2,n2)-x(2,n1))*fx(i,n))
313 ar(1,n1) = ar(1,n1) + xm
314 ar(2,n1) = ar(2,n1) + ym
315 ar(3,n1) = ar(3,n1) + zm
316 ar(1,n2) = ar(1,n2) - xm
317 ar(2,n2) = ar(2,n2) - ym
318 ar(3,n2) = ar(3,n2) - zm
319 ENDDO
320 ENDDO
321 END IF
322 ELSEIF(isrot == 2)THEN
323
324 DO n=1,4
325 DO i=1,nel
326 nn = nc(i,n)
327 a(1,nn)=a(1,nn)+fx(i,n)
328 a(2,nn)=a(2,nn)+fy(i,n)
329 a(3,nn)=a(3,nn)+fz(i,n)
330 stifn(nn)=stifn(nn)+sti(i)*two
331 ENDDO
332 ENDDO
333 DO n=5,10
334 DO i=1,nel
335 nn = nc(i,n)
336 IF(nn == 0)THEN
337 n1=nc(i,iperm1(n))
338 n2=nc(i,iperm2(n))
339 a(1,n1)=a(1,n1)+half*fx(i,n)
340 a(2,n1)=a(2,n1)+half*fy(i,n)
341 a(3,n1)=a(3,n1)+half*fz(i,n)
342 a(1,n2)=a(1,n2)+half*fx(i,n)
343 a(2,n2)=a(2,n2)+half*fy(i,n)
344 a(3,n2)=a(3,n2)+half*fz(i,n)
345 ELSEIF(itagdn(nn)/=0) THEN
346C-----------will be done in resol
347 a(1,nn)=a(1,nn)+fx(i,n)
348 a(2,nn)=a(2,nn)+fy(i,n)
349 a(3,nn)=a(3,nn)+fz(i,n)
350 stifn(nn)=stifn(nn)+sti(i)*facirot2
351 ENDIF
352 ENDDO
353 ENDDO
354 ENDIF
355 END IF
356C
357
358 IF(jthe < 0 ) THEN
359C
360C + heat transfort
361C
362 DO n=1,4
363 DO i=1,nel
364 nn = nc(i,n)
365 fthe(nn)= fthe(nn) + them(i,n)
366 ENDDO
367 ENDDO
368C
369 IF(isrot == 0)THEN
370 DO n=5,10
371 DO i=1,nel
372 nn = nc(i,n)
373 IF(nn/=0)THEN
374 fthe(nn)= fthe(nn) + them(i,n)
375 ELSE
376 n1=nc(i,iperm1(n))
377 n2=nc(i,iperm2(n))
378 fthe(n1)= fthe(n1) + half*them(i,n)
379 fthe(n2)= fthe(n2) + half*them(i,n)
380 ENDIF
381 ENDDO
382 ENDDO
383 ENDIF
384
385 ENDIF
386C
387C + Thermal time step
388C
389 IF(nodadt_therm == 1 ) THEN
390
391 DO i=1,nel
392 conde(i)=fourth*conde(i)
393 END DO
394
395
396 IF(isrot == 0)THEN
397 DO n=1,4
398 DO i=1,nel
399 nn = nc(i,n)
400 condn(nn)= condn(nn) + conde(i)*deltax2(i)
401 ENDDO
402 ENDDO
403
404 DO n=5,10
405 DO i=1,nel
406 nn = nc(i,n)
407 IF(nn/=0)THEN
408 condn(nn)= condn(nn) + conde(i)
409 ELSE
410 n1=nc(i,iperm1(n))
411 n2=nc(i,iperm2(n))
412 condn(n1)= condn(n1)+half*conde(i)
413 condn(n2)= condn(n2)+half*conde(i)
414 ENDIF
415 ENDDO
416 ENDDO
417
418 ELSEIF(isrot == 1)THEN
419
420 DO n=1,4
421 DO i=1,nel
422 nn = nc(i,n)
423 condn(nn)= condn(nn) + conde(i)*deltax2(i)*three*one_over_8
424 ENDDO
425 ENDDO
426 ELSEIF(isrot == 2)THEN
427
428 DO n=1,4
429 DO i=1,nel
430 nn = nc(i,n)
431 condn(nn)= condn(nn) + conde(i)*two
432 ENDDO
433 ENDDO
434 DO n=5,10
435 DO i=1,nel
436 nn = nc(i,n)
437 IF(nn/=0.AND.itagdn(nn)/=0) THEN
438 condn(nn)= condn(nn) + conde(i)*facirot2
439 ENDIF
440 ENDDO
441 ENDDO
442 ENDIF
443
444
445 ENDIF
446
447 IF(nsect>0)THEN
448 DO n=5,10
449 DO i=1,nel
450 nn = nc(i,n)
451 IF(nn==0)THEN
452 n1=iperm1(n)
453 n2=iperm2(n)
454 fx(i,n1)=fx(i,n1)+half*fx(i,n)
455 fy(i,n1)=fy(i,n1)+half*fy(i,n)
456 fz(i,n1)=fz(i,n1)+half*fz(i,n)
457 fx(i,n2)=fx(i,n2)+half*fx(i,n)
458 fy(i,n2)=fy(i,n2)+half*fy(i,n)
459 fz(i,n2)=fz(i,n2)+half*fz(i,n)
460 END IF
461 END DO
462 END DO
463 END IF
464
465 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20