OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10mass3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "vect01_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s10mass3 (mass, ms, partsav, ipart, mss, volu, xx, yy, zz, vx, vy, vz, nc, sti, stifn, deltax2, mssx, masscp, mcp, mcps, mcpsx, in, stifr, ins, mssa, x, fill, imas_ds)
subroutine s10msi (rho, mass, volu, dtelem, sti, off, sig, eint, offg, sigg, eintg, rhog, wip, masscp, rhocp, fill, nel, dtx)
subroutine s4fraca10 (x, ix1, ix2, ix3, ix4, ptg, imas_ds)

Function/Subroutine Documentation

◆ s10mass3()

subroutine s10mass3 ( mass,
ms,
partsav,
integer, dimension(*) ipart,
mss,
volu,
double precision, dimension(mvsiz,10) xx,
double precision, dimension(mvsiz,10) yy,
double precision, dimension(mvsiz,10) zz,
vx,
vy,
vz,
integer, dimension(mvsiz,10) nc,
sti,
stifn,
deltax2,
mssx,
masscp,
mcp,
mcps,
mcpsx,
in,
stifr,
ins,
mssa,
x,
fill,
integer, intent(in) imas_ds )

Definition at line 31 of file s10mass3.F.

37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "vect01_c.inc"
50#include "scr17_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(IN) :: IMAS_DS
55 INTEGER IPART(*), NC(MVSIZ,10)
56 double precision
57 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10)
58C REAL
59 my_real
60 . mass(*), ms(*),partsav(20,*), mss(8,*),deltax2(*),
61 . volu(*),
62 . vx(mvsiz,10), vy(mvsiz,10), vz(mvsiz,10),sti(*),stifn(*),
63 . mssx(12,*), masscp(*), mcp(*) ,mcps(8,*) ,mcpsx(12,*),
64 . in(*),stifr(*),ins(8,*), mssa(*), x(3,*), fill(*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, IP,N1,N2,N11,N22,IPERM1(10),IPERM2(10),N,IPERM3(10)
69C REAL
70 my_real
71 . axx,ayy,azz,axy,ayz,azx,am,bm,fac,bi,aaa,facirot,ptg(10,mvsiz),
72 . bbb
73C
74 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
75 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
76 DATA iperm3/1,3,6,5,0,0,0,0,0,0/
77C
78C-----------------------------------------------------------------------
79 fac=trhee_over_14
80 facirot = nine + third
81
82 IF(irest_mselt /= 0)THEN
83 DO i=lft,llt
84 mssa(i)=mass(i)
85 ENDDO
86 ENDIF
87 CALL s4fraca10(x,nc(1,1),nc(1,2),nc(1,3),nc(1,4),ptg ,imas_ds)
88C
89 IF(idt1tet10==0.AND.isrot == 0)THEN
90C same as RD Engine
91 DO i=lft,llt
92 sti(i)=fourth*sti(i)
93 ENDDO
94 END IF
95 DO i=lft,llt
96 IF(isrot == 0)THEN
97 IF(idt1tet10==0)THEN
98 am = mass(i)*fac/(four*fac + six)
99 bm = mass(i)*one/(four*fac + six)
100 mss(1,i)=am*ptg(1,i)
101 mss(3,i)=am*ptg(2,i)
102 mss(6,i)=am*ptg(3,i)
103 mss(5,i)=am*ptg(4,i)
104 stifn(nc(i,1))=stifn(nc(i,1))+sti(i)*deltax2(i)
105 stifn(nc(i,2))=stifn(nc(i,2))+sti(i)*deltax2(i)
106 stifn(nc(i,3))=stifn(nc(i,3))+sti(i)*deltax2(i)
107 stifn(nc(i,4))=stifn(nc(i,4))+sti(i)*deltax2(i)
108 DO n=5,10
109 IF(nc(i,n)/=0)THEN
110 mssx(n-4,i)=bm*ptg(n,i)
111 stifn(nc(i,n))=stifn(nc(i,n))+sti(i)
112 ELSE
113 n11=iperm1(n)
114 n1=iperm3(n11)
115 n22=iperm2(n)
116 n2=iperm3(n22)
117 mss(n1,i)=mss(n1,i) + half*bm*ptg(n,i)
118 mss(n2,i)=mss(n2,i) + half*bm*ptg(n,i)
119 stifn(nc(i,n11))=stifn(nc(i,n11)) + half*sti(i)
120 stifn(nc(i,n22))=stifn(nc(i,n22)) + half*sti(i)
121 ENDIF
122 ENDDO
123 ELSE
124C
125C Not yet compatible with IMAS_DS/=0
126 am = mass(i)*fac/(four*fac + six)
127 bm = mass(i)*one/(four*fac + six)
128 mss(1,i)=am
129 mss(3,i)=am
130 mss(6,i)=am
131 mss(5,i)=am
132 aaa=sti(i)*two/thirty2
133 bbb=sti(i)*two*seven/fourty8
134 stifn(nc(i,1))=stifn(nc(i,1))+aaa
135 stifn(nc(i,2))=stifn(nc(i,2))+aaa
136 stifn(nc(i,3))=stifn(nc(i,3))+aaa
137 stifn(nc(i,4))=stifn(nc(i,4))+aaa
138 DO n=5,10
139 IF(nc(i,n)/=0)THEN
140 mssx(n-4,i)=bm
141 stifn(nc(i,n))=stifn(nc(i,n))+bbb
142 ELSE
143 n11=iperm1(n)
144 n1 =iperm3(n11)
145 n22=iperm2(n)
146 n2 =iperm3(n22)
147 mss(n1,i)=mss(n1,i) + half*bm
148 mss(n2,i)=mss(n2,i) + half*bm
149 stifn(nc(i,n11))=stifn(nc(i,n11)) + half*bbb
150 stifn(nc(i,n22))=stifn(nc(i,n22)) + half*bbb
151 ENDIF
152 ENDDO
153 END IF
154 ELSE IF(isrot == 1)THEN
155 am = mass(i)/four
156 aaa = ((six*sqr2*four*volu(i))**two_third)
157 bm = zero
158c BI = (BM*AAA*THREE/EIGHT)
159c BI = (BM*AAA*THREE/EIGHT)*EIGHT
160c BI = (AM*AAA/FOUR)*EIGHT
161 bi = (seven/five)*deltax2(i)*mass(i)
162 mss(1,i)=am*ptg(1,i)
163 mss(3,i)=am*ptg(2,i)
164 mss(6,i)=am*ptg(3,i)
165 mss(5,i)=am*ptg(4,i)
166 aaa = sti(i)*two/four
167 stifn(nc(i,1))=stifn(nc(i,1))+aaa
168 stifn(nc(i,2))=stifn(nc(i,2))+aaa
169 stifn(nc(i,3))=stifn(nc(i,3))+aaa
170 stifn(nc(i,4))=stifn(nc(i,4))+aaa
171 ins(1,i)= bi
172 ins(3,i)= bi
173 ins(6,i)= bi
174 ins(5,i)= bi
175 aaa = sti(i)*deltax2(i)*three/eight/four
176 stifr(nc(i,1))=stifr(nc(i,1))+aaa
177 stifr(nc(i,2))=stifr(nc(i,2))+aaa
178 stifr(nc(i,3))=stifr(nc(i,3))+aaa
179 stifr(nc(i,4))=stifr(nc(i,4))+aaa
180
181 ELSE IF(isrot == 2)THEN
182
183 IF(idt1tet10==0)THEN
184 am = mass(i)/four
185 aaa = ((six*sqr2*four*volu(i))**two_third)
186 bm = zero
187c BI = (BM*AAA*THREE/EIGHT)
188c BI = (BM*AAA*THREE/EIGHT)*EIGHT
189c BI = (AM*AAA/FOUR)*EIGHT
190c BI = (SEVEN/FIVE)*DELTAX2(I)*MASS(I)
191 mss(1,i)=am*ptg(1,i)
192 mss(3,i)=am*ptg(2,i)
193 mss(6,i)=am*ptg(3,i)
194 mss(5,i)=am*ptg(4,i)
195 aaa = sti(i)*two/four
196 stifn(nc(i,1))=stifn(nc(i,1))+aaa
197 stifn(nc(i,2))=stifn(nc(i,2))+aaa
198 stifn(nc(i,3))=stifn(nc(i,3))+aaa
199 stifn(nc(i,4))=stifn(nc(i,4))+aaa
200 DO n=5,10
201 IF(nc(i,n)/=0)THEN
202 mssx(n-4,i) = am*facirot
203 stifn(nc(i,n))=stifn(nc(i,n))+aaa*facirot
204 ENDIF
205 ENDDO
206 ELSE
207C
208C Not yet compatible with IMAS_DS/=0
209 am = mass(i)/four
210 bm = zero
211 mss(1,i)=am
212 mss(3,i)=am
213 mss(6,i)=am
214 mss(5,i)=am
215 aaa = sti(i)*two/four
216 stifn(nc(i,1))=stifn(nc(i,1))+aaa
217 stifn(nc(i,2))=stifn(nc(i,2))+aaa
218 stifn(nc(i,3))=stifn(nc(i,3))+aaa
219 stifn(nc(i,4))=stifn(nc(i,4))+aaa
220 DO n=5,10
221 IF(nc(i,n)/=0)THEN
222 mssx(n-4,i) = am*facirot ! meme masse que dans le cas standard
223 stifn(nc(i,n))=stifn(nc(i,n))+aaa*facirot
224 ENDIF
225 ENDDO
226 END IF
227
228 ENDIF
229C
230 ip=ipart(i)
231 partsav(1,ip)=partsav(1,ip) + mass(i)
232 partsav(2,ip)=partsav(2,ip)
233 . + am*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
234 . + bm*(xx(i,5)+xx(i,6)+xx(i,7)+xx(i,8)+xx(i,9)+xx(i,10))
235 partsav(3,ip)=partsav(3,ip)
236 . + am*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
237 . + bm*(yy(i,5)+yy(i,6)+yy(i,7)+yy(i,8)+yy(i,9)+yy(i,10))
238 partsav(4,ip)=partsav(4,ip)
239 . + am*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
240 . + bm*(zz(i,5)+zz(i,6)+zz(i,7)+zz(i,8)+zz(i,9)+zz(i,10))
241 axx = am*(xx(i,1)*xx(i,1)+xx(i,2)*xx(i,2)
242 . +xx(i,3)*xx(i,3)+xx(i,4)*xx(i,4))
243 . +bm*(xx(i,5)*xx(i,5)+xx(i,6)*xx(i,6)
244 . +xx(i,7)*xx(i,7)+xx(i,8)*xx(i,8)
245 . +xx(i,9)*xx(i,9)+xx(i,10)*xx(i,10))
246 ayy = am*(yy(i,1)*yy(i,1)+yy(i,2)*yy(i,2)
247 . +yy(i,3)*yy(i,3)+yy(i,4)*yy(i,4))
248 . +bm*(yy(i,5)*yy(i,5)+yy(i,6)*yy(i,6)
249 . +yy(i,7)*yy(i,7)+yy(i,8)*yy(i,8)
250 . +yy(i,9)*yy(i,9)+yy(i,10)*yy(i,10))
251 azz = am*(zz(i,1)*zz(i,1)+zz(i,2)*zz(i,2)
252 . +zz(i,3)*zz(i,3)+zz(i,4)*zz(i,4))
253 . +bm*(zz(i,5)*zz(i,5)+zz(i,6)*zz(i,6)
254 . +zz(i,7)*zz(i,7)+zz(i,8)*zz(i,8)
255 . +zz(i,9)*zz(i,9)+zz(i,10)*zz(i,10))
256 axy = am*(xx(i,1)*yy(i,1)+xx(i,2)*yy(i,2)
257 . +xx(i,3)*yy(i,3)+xx(i,4)*yy(i,4))
258 . +bm*(xx(i,5)*yy(i,5)+xx(i,6)*yy(i,6)
259 . +xx(i,7)*yy(i,7)+xx(i,8)*yy(i,8)
260 . +xx(i,9)*yy(i,9)+xx(i,10)*yy(i,10))
261 ayz = am*(yy(i,1)*zz(i,1)+yy(i,2)*zz(i,2)
262 . +yy(i,3)*zz(i,3)+yy(i,4)*zz(i,4))
263 . +bm*(yy(i,5)*zz(i,5)+yy(i,6)*zz(i,6)
264 . +yy(i,7)*zz(i,7)+yy(i,8)*zz(i,8)
265 . +yy(i,9)*zz(i,9)+yy(i,10)*zz(i,10))
266 azx = am*(zz(i,1)*xx(i,1)+zz(i,2)*xx(i,2)
267 . +zz(i,3)*xx(i,3)+zz(i,4)*xx(i,4))
268 . +bm*(zz(i,5)*xx(i,5)+zz(i,6)*xx(i,6)
269 . +zz(i,7)*xx(i,7)+zz(i,8)*xx(i,8)
270 . +zz(i,9)*xx(i,9)+zz(i,10)*xx(i,10))
271 partsav(5,ip) =partsav(5,ip) + (ayy+azz)
272 partsav(6,ip) =partsav(6,ip) + (azz+axx)
273 partsav(7,ip) =partsav(7,ip) + (axx+ayy)
274 partsav(8,ip) =partsav(8,ip) - axy
275 partsav(9,ip) =partsav(9,ip) - ayz
276 partsav(10,ip)=partsav(10,ip) - azx
277C
278 partsav(11,ip)=partsav(11,ip)
279 . + am*(vx(i,1)+vx(i,2)+vx(i,3)+vx(i,4))
280 . + bm*(vx(i,5)+vx(i,6)+vx(i,7)+vx(i,8)+vx(i,9)+vx(i,10))
281 partsav(12,ip)=partsav(12,ip)
282 . + am*(vy(i,1)+vy(i,2)+vy(i,3)+vy(i,4))
283 . + bm*(vy(i,5)+vy(i,6)+vy(i,7)+vy(i,8)+vy(i,9)+vy(i,10))
284 partsav(13,ip)=partsav(13,ip)
285 . + am*(vz(i,1)+vz(i,2)+vz(i,3)+vz(i,4))
286 . + bm*(vz(i,5)+vz(i,6)+vz(i,7)+vz(i,8)+vz(i,9)+vz(i,10))
287 partsav(14,ip)=partsav(14,ip) + half *
288 . (am*(vx(i,1)*vx(i,1)+vx(i,2)*vx(i,2)
289 . +vx(i,3)*vx(i,3)+vx(i,4)*vx(i,4)
290 . +vy(i,1)*vy(i,1)+vy(i,2)*vy(i,2)
291 . +vy(i,3)*vy(i,3)+vy(i,4)*vy(i,4)
292 . +vz(i,1)*vz(i,1)+vz(i,2)*vz(i,2)
293 . +vz(i,3)*vz(i,3)+vz(i,4)*vz(i,4))
294 . +bm*(vx(i,5)*vx(i,5)+vx(i,6)*vx(i,6)
295 . +vx(i,7)*vx(i,7)+vx(i,8)*vx(i,8)
296 . +vx(i,9)*vx(i,9)+vx(i,10)*vx(i,10)
297 . +vy(i,5)*vy(i,5)+vy(i,6)*vy(i,6)
298 . +vy(i,7)*vy(i,7)+vy(i,8)*vy(i,8)
299 . +vy(i,9)*vy(i,9)+vy(i,10)*vy(i,10)
300 . +vz(i,5)*vz(i,5)+vz(i,6)*vz(i,6)
301 . +vz(i,7)*vz(i,7)+vz(i,8)*vz(i,8)
302 . +vz(i,9)*vz(i,9)+vz(i,10)*vz(i,10)))
303 ENDDO
304
305 IF(jthe < 0) THEN
306 DO i=lft,llt
307 fac=trhee_over_14
308 am = masscp(i)*fac/(four*fac + six)
309 bm = masscp(i)*one/(four*fac + six)
310 mcps(1,i)=am
311 mcps(3,i)=am
312 mcps(6,i)=am
313 mcps(5,i)=am
314 DO n=5,10
315 IF(nc(i,n)/=0)THEN
316 mcpsx(n-4,i) = bm
317 ELSE
318 n11=iperm1(n)
319 n1=iperm3(n11)
320 n22=iperm2(n)
321 n2=iperm3(n22)
322 mcps(n1,i)=mcps(n1,i) + half*bm
323 mcps(n2,i)=mcps(n2,i) + half*bm
324 ENDIF
325 ENDDO
326 ENDDO
327 ENDIF
328C
329 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
s4fraca10
subroutine s4fraca10(x, ix1, ix2, ix3, ix4, ptg, imas_ds)
Definition s10mass3.F:411

◆ s10msi()

subroutine s10msi ( rho,
mass,
volu,
dtelem,
sti,
off,
sig,
eint,
offg,
sigg,
eintg,
rhog,
wip,
masscp,
rhocp,
fill,
integer nel,
dtx )

Definition at line 337 of file s10mass3.F.

341C
342C-----------------------------------------------
343C I m p l i c i t T y p e s
344C-----------------------------------------------
345#include "implicit_f.inc"
346C-----------------------------------------------
347C D u m m y A r g u m e n t s
348C-----------------------------------------------
349 INTEGER NEL
350C REAL
351 my_real
352 . rho(*), mass(*),volu(*),dtelem(*),sti(*),
353 . sig(nel,6),eint(*),off(*),
354 . sigg(nel,6),eintg(*),rhog(*),offg(*),wip,
355 . rhocp(*) ,masscp(*), fill(*), dtx(*)
356C-----------------------------------------------
357C C o m m o n B l o c k s
358C-----------------------------------------------
359#include "vect01_c.inc"
360C-----------------------------------------------
361C L o c a l V a r i a b l e s
362C-----------------------------------------------
363 INTEGER I
364C
365 IF(jthe < 0) THEN
366 DO i=lft,llt
367 mass(i)=mass(i)+fill(i)*rho(i)*volu(i)
368 dtelem(i)=min(dtelem(i),dtx(i))
369 sti(i) = sti(i) + fill(i) * rho(i) * volu(i) / max(em20,dtx(i)*dtx(i))
370 sigg(i,1) = sigg(i,1) + wip * sig(i,1)
371 sigg(i,2) = sigg(i,2) + wip * sig(i,2)
372 sigg(i,3) = sigg(i,3) + wip * sig(i,3)
373 sigg(i,4) = sigg(i,4) + wip * sig(i,4)
374 sigg(i,5) = sigg(i,5) + wip * sig(i,5)
375 sigg(i,6) = sigg(i,6) + wip * sig(i,6)
376 rhog(i) = rhog(i) + wip * rho(i)
377 eintg(i) = eintg(i) + wip * eint(i)
378 offg(i) = off(i)
379 masscp(i) = masscp(i) + fill(i)*rhocp(i)*volu(i)
380 ENDDO
381 ELSE
382 DO i=lft,llt
383 mass(i)=mass(i)+fill(i)*rho(i)*volu(i)
384 dtelem(i)=min(dtelem(i),dtx(i))
385 sti(i) = sti(i) + fill(i) * rho(i) * volu(i) / max(em20,dtx(i)*dtx(i))
386 sigg(i,1) = sigg(i,1) + wip * sig(i,1)
387 sigg(i,2) = sigg(i,2) + wip * sig(i,2)
388 sigg(i,3) = sigg(i,3) + wip * sig(i,3)
389 sigg(i,4) = sigg(i,4) + wip * sig(i,4)
390 sigg(i,5) = sigg(i,5) + wip * sig(i,5)
391 sigg(i,6) = sigg(i,6) + wip * sig(i,6)
392 rhog(i) = rhog(i) + wip * rho(i)
393 eintg(i) = eintg(i) + wip * eint(i)
394 offg(i) = off(i)
395 masscp(i) = masscp(i) + fill(i)*rhocp(i)*volu(i)
396 ENDDO
397
398
399 ENDIF
400C
401 RETURN
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ s4fraca10()

subroutine s4fraca10 ( x,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) ix3,
integer, dimension(*) ix4,
ptg,
integer, intent(in) imas_ds )

Definition at line 410 of file s10mass3.F.

411C----------------------------------------------
412C MASS PARTITION IN FUNCTION OF NODAL ANGLES by AREA
413C-----------------------------------------------
414C I m p l i c i t T y p e s
415C-----------------------------------------------
416#include "implicit_f.inc"
417C-----------------------------------------------
418C G l o b a l P a r a m e t e r s
419C-----------------------------------------------
420#include "mvsiz_p.inc"
421C-----------------------------------------------
422C C o m m o n B l o c k s
423C-----------------------------------------------
424#include "vect01_c.inc"
425C-----------------------------------------------
426C D u m m y A r g u m e n t s
427C-----------------------------------------------
428 INTEGER IX1(*), IX2(*), IX3(*),IX4(*)
429 my_real
430 . x(3,*),ptg(10,*)
431C-----------------------------------------------
432C L o c a l V a r i a b l e s
433C-----------------------------------------------
434 INTEGER, INTENT(IN) :: IMAS_DS
435 INTEGER I,J,K,N,IP,I1,I2,I3,I4
436 my_real
437 . xx,yy,zz,xy,yz,zx,p1,p2,p3,p4,s
438 my_real
439 . a1(mvsiz), a2(mvsiz), a3(mvsiz),a4(mvsiz)
440C=======================================================================
441 IF (imas_ds==0) THEN
442 DO i=lft,llt
443 DO j=1,10
444 ptg(j,i)=one
445 END DO
446 END DO
447 RETURN
448 END IF
449C ---------------------------------
450 CALL area_tria(x,ix2,ix3,ix4, a1 )
451 CALL area_tria(x,ix1,ix3,ix4, a2 )
452 CALL area_tria(x,ix1,ix2,ix4, a3 )
453 CALL area_tria(x,ix1,ix2,ix3, a4 )
454 DO i=lft,llt
455 s = four/(a1(i) +a2(i) +a3(i) +a4(i))
456 ptg(1,i)=a1(i)*s
457 ptg(2,i)=a2(i)*s
458 ptg(3,i)=a3(i)*s
459 ptg(4,i)=a4(i)*s
460 ptg(5,i)=half*(ptg(1,i)+ptg(2,i))
461 ptg(6,i)=half*(ptg(2,i)+ptg(3,i))
462 ptg(7,i)=half*(ptg(1,i)+ptg(3,i))
463 ptg(8,i)=half*(ptg(1,i)+ptg(4,i))
464 ptg(9,i)=half*(ptg(2,i)+ptg(4,i))
465 ptg(10,i)=half*(ptg(3,i)+ptg(4,i))
466 END DO
467C
468C-----------
469 RETURN
area_tria
subroutine area_tria(x, n1, n2, n3, a2)
Definition s4mass3.F:410