OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4mass3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s4mass3 (rho, ms, partsav, x, v, ipart, mss, msnf, mssf, wma, rhocp, mcp, mcps, temp0, temp, mssa, ix1, ix2, ix3, ix4, fill, volu, imas_ds, nintemp)
subroutine s4frac (x, ix1, ix2, ix3, ix4, ptg)
subroutine dis_n1n2 (x, n1, n2, s, s2)
subroutine s4fraca (x, ix1, ix2, ix3, ix4, ptg, imas_ds)
subroutine area_tria (x, n1, n2, n3, a2)

Function/Subroutine Documentation

◆ area_tria()

subroutine area_tria ( x,
integer, dimension(*) n1,
integer, dimension(*) n2,
integer, dimension(*) n3,
a2 )

Definition at line 409 of file s4mass3.F.

410C----------------------------------------------
411C-----------------------------------------------
412C I m p l i c i t T y p e s
413C-----------------------------------------------
414#include "implicit_f.inc"
415C-----------------------------------------------
416C G l o b a l P a r a m e t e r s
417C-----------------------------------------------
418#include "mvsiz_p.inc"
419C-----------------------------------------------
420C C o m m o n B l o c k s
421C-----------------------------------------------
422#include "vect01_c.inc"
423C-----------------------------------------------
424C D u m m y A r g u m e n t s
425C-----------------------------------------------
426 INTEGER N1(*),N2(*),N3(*)
427 my_real
428 . x(3,*),a2(*)
429C-----------------------------------------------
430C L o c a l V a r i a b l e s
431C-----------------------------------------------
432 INTEGER I,J,K
433 my_real
434 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
435 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
436 . z1(mvsiz),z2(mvsiz),z3(mvsiz),
437 . x13, y13, z13, x12, y12, z12,
438 . e3x, e3y, e3z, surf
439C=======================================================================
440 DO i=lft,llt
441 x1(i)=x(1,n1(i))
442 y1(i)=x(2,n1(i))
443 z1(i)=x(3,n1(i))
444 x2(i)=x(1,n2(i))
445 y2(i)=x(2,n2(i))
446 z2(i)=x(3,n2(i))
447 x3(i)=x(1,n3(i))
448 y3(i)=x(2,n3(i))
449 z3(i)=x(3,n3(i))
450 ENDDO
451 DO i=lft,llt
452 x13=x3(i)-x1(i)
453 y13=y3(i)-y1(i)
454 z13=z3(i)-z1(i)
455 x12=x2(i)-x1(i)
456 y12=y2(i)-y1(i)
457 z12=z2(i)-z1(i)
458 e3x=y12*z13-z12*y13
459 e3y=z12*x13-x12*z13
460 e3z=x12*y13-y12*x13
461 a2(i)=sqrt(fourth*(e3x*e3x+e3y*e3y+e3z*e3z))
462 ENDDO
463C-----------
464 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ dis_n1n2()

subroutine dis_n1n2 ( x,
integer, dimension(*) n1,
integer, dimension(*) n2,
s,
s2 )

Definition at line 307 of file s4mass3.F.

308C----------------------------------------------
309C S=L(N1,N2)
310C-----------------------------------------------
311C I m p l i c i t T y p e s
312C-----------------------------------------------
313#include "implicit_f.inc"
314C-----------------------------------------------
315C C o m m o n B l o c k s
316C-----------------------------------------------
317#include "vect01_c.inc"
318C-----------------------------------------------
319C D u m m y A r g u m e n t s
320C-----------------------------------------------
321 INTEGER N1(*),N2(*)
322 my_real
323 . x(3,*),s(*),s2(*)
324C-----------------------------------------------
325C L o c a l V a r i a b l e s
326C-----------------------------------------------
327 INTEGER I,J,K
328 my_real
329 . xx,yy,zz,xy,yz,zx
330C=======================================================================
331 DO i=lft,llt
332 xx = x(1,n2(i))-x(1,n1(i))
333 yy = x(2,n2(i))-x(2,n1(i))
334 zz = x(3,n2(i))-x(3,n1(i))
335 s2(i) = xx*xx+yy*yy+zz*zz
336 s(i) = sqrt(s2(i))
337 END DO
338C-----------
339 RETURN

◆ s4frac()

subroutine s4frac ( x,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) ix3,
integer, dimension(*) ix4,
ptg )

Definition at line 228 of file s4mass3.F.

229C----------------------------------------------
230C MASS PARTITION IN FUNCTION OF NODAL ANGLES
231C-----------------------------------------------
232C I m p l i c i t T y p e s
233C-----------------------------------------------
234#include "implicit_f.inc"
235C-----------------------------------------------
236C G l o b a l P a r a m e t e r s
237C-----------------------------------------------
238#include "mvsiz_p.inc"
239C-----------------------------------------------
240C C o m m o n B l o c k s
241C-----------------------------------------------
242#include "vect01_c.inc"
243C-----------------------------------------------
244C D u m m y A r g u m e n t s
245C-----------------------------------------------
246 INTEGER IX1(*), IX2(*), IX3(*),IX4(*)
247 my_real
248 . x(3,*),ptg(4,*)
249C-----------------------------------------------
250C L o c a l V a r i a b l e s
251C-----------------------------------------------
252 INTEGER I,J,K,N,IP,I1,I2,I3,I4
253 my_real
254 . xx,yy,zz,xy,yz,zx,p1,p2,p3,p4,s
255 my_real
256 . a2(mvsiz), b2(mvsiz), c2(mvsiz),d2(mvsiz),e2(mvsiz),f2(mvsiz),
257 . aa(mvsiz), bb(mvsiz), cc(mvsiz),dd(mvsiz),ee(mvsiz),ff(mvsiz)
258C=======================================================================
259C----------------------------------------------
260C MASSES ELEMENTAIRES
261C----------------------------------------------
262C
263 CALL dis_n1n2(x,ix1,ix2,aa,a2 )
264 CALL dis_n1n2(x,ix2,ix3,bb,b2 )
265 CALL dis_n1n2(x,ix3,ix1,cc,c2 )
266 CALL dis_n1n2(x,ix2,ix4,dd,d2 )
267 CALL dis_n1n2(x,ix3,ix4,ee,e2 )
268 CALL dis_n1n2(x,ix1,ix4,ff,f2 )
269 DO i=lft,llt
270 p1 = acos((a2(i) + c2(i) - b2(i))/(two * aa(i) * cc(i)))
271 p2 = acos((a2(i) + f2(i) - d2(i))/(two * aa(i) * ff(i)))
272 p3 = acos((c2(i) + f2(i) - e2(i))/(two * cc(i) * ff(i)))
273 p1 = acos((a2(i) + c2(i) - b2(i))/(two * aa(i) * cc(i)))+
274 + acos((a2(i) + f2(i) - d2(i))/(two * aa(i) * ff(i)))+
275 + acos((c2(i) + f2(i) - e2(i))/(two * cc(i) * ff(i)))
276C
277 p2 = acos((a2(i) + b2(i) - c2(i))/(two * aa(i) * bb(i)))+
278 + acos((a2(i) + d2(i) - f2(i))/(two * aa(i) * dd(i)))+
279 + acos((d2(i) + b2(i) - e2(i))/(two * dd(i) * bb(i)))
280C
281 p3 = acos((b2(i) + c2(i) - a2(i))/(two * bb(i) * cc(i)))+
282 + acos((b2(i) + e2(i) - d2(i))/(two * bb(i) * ee(i)))+
283 + acos((e2(i) + c2(i) - f2(i))/(two * ee(i) * cc(i)))
284C
285 p4 = acos((f2(i) + d2(i) - a2(i))/(two * ff(i) * dd(i)))+
286 + acos((d2(i) + e2(i) - b2(i))/(two * dd(i) * ee(i)))+
287 + acos((e2(i) + f2(i) - c2(i))/(two * ee(i) * ff(i)))
288 ptg(1,i)=p1/pi
289 ptg(2,i)=p2/pi
290 ptg(3,i)=p3/pi
291 ptg(4,i)=p4/pi
292 s=ptg(1,i)+ptg(2,i)+ptg(3,i)+ptg(4,i)
293c PTG(1,I)=ONE
294c PTG(2,I)=ONE
295c PTG(3,I)=ONE
296c PTG(4,I)=ONE
297 END DO
298C
299C-----------
300 RETURN
dis_n1n2
subroutine dis_n1n2(x, n1, n2, s, s2)
Definition s4mass3.F:308

◆ s4fraca()

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

Definition at line 348 of file s4mass3.F.

349C----------------------------------------------
350C MASS PARTITION IN FUNCTION OF NODAL ANGLES by AREA
351C-----------------------------------------------
352C I m p l i c i t T y p e s
353C-----------------------------------------------
354#include "implicit_f.inc"
355C-----------------------------------------------
356C G l o b a l P a r a m e t e r s
357C-----------------------------------------------
358#include "mvsiz_p.inc"
359C-----------------------------------------------
360C C o m m o n B l o c k s
361C-----------------------------------------------
362#include "vect01_c.inc"
363C-----------------------------------------------
364C D u m m y A r g u m e n t s
365C-----------------------------------------------
366 INTEGER, INTENT(IN) :: IMAS_DS
367 INTEGER IX1(*), IX2(*), IX3(*),IX4(*)
368 my_real
369 . x(3,*),ptg(4,*)
370C-----------------------------------------------
371C L o c a l V a r i a b l e s
372C-----------------------------------------------
373 INTEGER I,J,K,N,IP,I1,I2,I3,I4
374 my_real
375 . xx,yy,zz,xy,yz,zx,p1,p2,p3,p4,s
376 my_real
377 . a1(mvsiz), a2(mvsiz), a3(mvsiz),a4(mvsiz)
378C=======================================================================
379 IF (imas_ds==0) THEN
380 DO i=lft,llt
381 DO j=1,4
382 ptg(j,i)=one
383 END DO
384 END DO
385 RETURN
386 END IF
387C ------------Ai -> A (i)-----------
388 CALL area_tria(x,ix2,ix3,ix4, a1 )
389 CALL area_tria(x,ix1,ix3,ix4, a2 )
390 CALL area_tria(x,ix1,ix2,ix4, a3 )
391 CALL area_tria(x,ix1,ix2,ix3, a4 )
392 DO i=lft,llt
393 s = four/(a1(i) +a2(i) +a3(i) +a4(i))
394 ptg(1,i)=a1(i)*s
395 ptg(2,i)=a2(i)*s
396 ptg(3,i)=a3(i)*s
397 ptg(4,i)=a4(i)*s
398 END DO
399C
400C-----------
401 RETURN
area_tria
subroutine area_tria(x, n1, n2, n3, a2)
Definition s4mass3.F:410

◆ s4mass3()

subroutine s4mass3 ( rho,
ms,
partsav,
x,
v,
integer, dimension(*) ipart,
mss,
msnf,
mssf,
wma,
rhocp,
mcp,
mcps,
temp0,
temp,
mssa,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) ix3,
integer, dimension(*) ix4,
fill,
volu,
integer, intent(in) imas_ds,
integer, intent(in) nintemp )

Definition at line 35 of file s4mass3.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE ale_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "vect01_c.inc"
59#include "sms_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER, INTENT(IN) :: IMAS_DS
64 INTEGER, INTENT(IN) :: NINTEMP
65 INTEGER IPART(*), IX1(*), IX2(*), IX3(*), IX4(*)
66 my_real
67 . rho(*), ms(*),x(3,*),v(3,*),partsav(20,*),msnf(*), mss(8,*),
68 . mssf(8,*),wma(*), rhocp(*),mcps(8,*),temp(*),temp0(*),mcp(*),
69 . mssa(*), fill(*), volu(*)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I,IP,I1,I2,I3,I4,j
74 my_real
75 . xx,yy,zz,xy,yz,zx, mass(mvsiz),rcp,ptg(4,mvsiz)
76C
77C-----------------------------------------------------------------------
78 IF(isms==0)
79 . CALL s4fraca(x,ix1 ,ix2,ix3 ,ix4 ,ptg ,imas_ds )
80 DO i=lft,llt
81 mass(i)=fill(i)*rho(i)*volu(i)*fourth
82C
83 i1 = ix1(i)
84 i2 = ix2(i)
85 i3 = ix3(i)
86 i4 = ix4(i)
87C
88 IF(isms==0)THEN
89 mss(1,i)=mass(i)*ptg(1,i)
90 mss(3,i)=mass(i)*ptg(2,i)
91 mss(6,i)=mass(i)*ptg(3,i)
92 mss(5,i)=mass(i)*ptg(4,i)
93 ELSE
94 mss(1,i)=mass(i)
95 mss(3,i)=mass(i)
96 mss(6,i)=mass(i)
97 mss(5,i)=mass(i)
98 END IF
99C
100 mss(2,i)=zero
101 mss(4,i)=zero
102 mss(7,i)=zero
103 mss(8,i)=zero
104C
105 ip=ipart(i)
106 partsav(1,ip)=partsav(1,ip) + four*mass(i)
107 partsav(2,ip)=partsav(2,ip)
108 . + mass(i)*(x(1,i1)+x(1,i2)+x(1,i3)+x(1,i4))
109 partsav(3,ip)=partsav(3,ip)
110 . + mass(i)*(x(2,i1)+x(2,i2)+x(2,i3)+x(2,i4))
111 partsav(4,ip)=partsav(4,ip)
112 . + mass(i)*(x(3,i1)+x(3,i2)+x(3,i3)+x(3,i4))
113 xx = (x(1,i1)*x(1,i1)+x(1,i2)*x(1,i2)
114 . +x(1,i3)*x(1,i3)+x(1,i4)*x(1,i4))
115 xy = (x(1,i1)*x(2,i1)+x(1,i2)*x(2,i2)
116 . +x(1,i3)*x(2,i3)+x(1,i4)*x(2,i4))
117 yy = (x(2,i1)*x(2,i1)+x(2,i2)*x(2,i2)
118 . +x(2,i3)*x(2,i3)+x(2,i4)*x(2,i4))
119 yz = (x(2,i1)*x(3,i1)+x(2,i2)*x(3,i2)
120 . +x(2,i3)*x(3,i3)+x(2,i4)*x(3,i4))
121 zz = (x(3,i1)*x(3,i1)+x(3,i2)*x(3,i2)
122 . +x(3,i3)*x(3,i3)+x(3,i4)*x(3,i4))
123 zx = (x(3,i1)*x(1,i1)+x(3,i2)*x(1,i2)
124 . +x(3,i3)*x(1,i3)+x(3,i4)*x(1,i4))
125 partsav(5,ip) =partsav(5,ip) + mass(i) * (yy+zz)
126 partsav(6,ip) =partsav(6,ip) + mass(i) * (zz+xx)
127 partsav(7,ip) =partsav(7,ip) + mass(i) * (xx+yy)
128 partsav(8,ip) =partsav(8,ip) - mass(i) * xy
129 partsav(9,ip) =partsav(9,ip) - mass(i) * yz
130 partsav(10,ip)=partsav(10,ip) - mass(i) * zx
131C
132 partsav(11,ip)=partsav(11,ip)
133 . + mass(i)*(v(1,i1)+v(1,i2)+v(1,i3)+v(1,i4))
134 partsav(12,ip)=partsav(12,ip)
135 . + mass(i)*(v(2,i1)+v(2,i2)+v(2,i3)+v(2,i4))
136 partsav(13,ip)=partsav(13,ip)
137 . + mass(i)*(v(3,i1)+v(3,i2)+v(3,i3)+v(3,i4))
138 partsav(14,ip)=partsav(14,ip) + half * mass(i) *
139 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1)
140 . +v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2)
141 . +v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3)
142 . +v(1,i4)*v(1,i4)+v(2,i4)*v(2,i4)+v(3,i4)*v(3,i4))
143 ENDDO
144C
145 IF(irest_mselt /= 0)THEN
146 DO i=lft,llt
147 mssa(nft+i)=mass(i)
148 ENDDO
149 ENDIF
150C
151 IF(jale+jeul > 0)THEN
152 DO i=lft,llt
153 i1 = ix1(i)
154 i2 = ix2(i)
155 i3 = ix3(i)
156 i4 = ix4(i)
157 mssf(1,i)=mass(i)
158 mssf(3,i)=mass(i)
159 mssf(6,i)=mass(i)
160 mssf(5,i)=mass(i)
161 mssf(2,i)=zero
162 mssf(4,i)=zero
163 mssf(7,i)=zero
164 mssf(8,i)=zero
165 ENDDO
166 ENDIF
167C
168 IF(jthe < 0 ) THEN
169 DO i=lft,llt
170 rcp=fill(i)*rhocp(i)*volu(i)*fourth
171 mcps(1,i) = rcp
172 mcps(3,i) = rcp
173 mcps(5,i) = rcp
174 mcps(6,i) = rcp
175 mcps(2,i) = zero
176 mcps(4,i) = zero
177 mcps(7,i) = zero
178 mcps(8,i) = zero
179 ENDDO
180 ENDIF
181C
182 IF(jale > 0 .AND. ale%GRID%NWALE == 4)THEN
183 DO i=lft,llt
184 i1 = ix1(i)
185 i2 = ix2(i)
186 i3 = ix3(i)
187 i4 = ix4(i)
188 wma(i1)=wma(i1)+three_half
189 wma(i2)=wma(i2)+three_half
190 wma(i3)=wma(i3)+three_half
191 wma(i4)=wma(i4)+three_half
192 ENDDO
193 ENDIF
194C
195 IF(jthe < 0 ) THEN
196 IF(nintemp > 0 ) THEN
197 DO i=lft,llt
198 i1 = ix1(i)
199 i2 = ix2(i)
200 i3 = ix3(i)
201 i4 = ix4(i)
202 IF(temp(i1)== zero) temp(i1) = temp0(i)
203 IF(temp(i2)== zero) temp(i2) = temp0(i)
204 IF(temp(i3)== zero) temp(i3) = temp0(i)
205 IF(temp(i4)== zero) temp(i4) = temp0(i)
206 ENDDO
207 ELSE
208 DO i=lft,llt
209 i1 = ix1(i)
210 i2 = ix2(i)
211 i3 = ix3(i)
212 i4 = ix4(i)
213 temp(i1) = temp0(i)
214 temp(i2) = temp0(i)
215 temp(i3) = temp0(i)
216 temp(i4) = temp0(i)
217 ENDDO
218 ENDIF
219 ENDIF
220C-----------
221 RETURN
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
s4fraca
subroutine s4fraca(x, ix1, ix2, ix3, ix4, ptg, imas_ds)
Definition s4mass3.F:349