OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
surfmas.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine surfmas (ms, ibufn, ity, amasu, x, id, addmas, admid, titr)

Function/Subroutine Documentation

◆ surfmas()

subroutine surfmas ( ms,
integer, dimension(*) ibufn,
integer ity,
amasu,
x,
integer id,
addmas,
integer admid,
character(len=nchartitle) titr )

Definition at line 32 of file surfmas.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE message_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER IBUFN(*),ITY,ID,ADMID
49 my_real ms(*),amasu,x(3,*),addmas
50 CHARACTER(LEN=NCHARTITLE)::TITR
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER K
56 . x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,
57 . x21,y21,z21,x31,y31,z31,x42,y42,z42,
58 . x32,y32,z32,e3x,e3y,e3z,smass,sum,area,
59 . a2,b2,c2,aa,bb,cc,ang1,ang2,ang3
60C=======================================================================
61 IF(ity /= 7)THEN
62C----------------------------------------------
63C MASSES ELEMENTS /4
64C----------------------------------------------
65 x1=x(1,ibufn(1))
66 y1=x(2,ibufn(1))
67 z1=x(3,ibufn(1))
68 x2=x(1,ibufn(2))
69 y2=x(2,ibufn(2))
70 z2=x(3,ibufn(2))
71 x3=x(1,ibufn(3))
72 y3=x(2,ibufn(3))
73 z3=x(3,ibufn(3))
74 x4=x(1,ibufn(4))
75 y4=x(2,ibufn(4))
76 z4=x(3,ibufn(4))
77C
78 x21=x2-x1
79 y21=y2-y1
80 z21=z2-z1
81 x31=x3-x1
82 y31=y3-y1
83 z31=z3-z1
84 x42=x4-x2
85 y42=y4-y2
86 z42=z4-z2
87C
88 e3x=y31*z42-z31*y42
89 e3y=z31*x42-x31*z42
90 e3z=x31*y42-y31*x42
91 sum=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
92 area=half*sum
93C
94C EMS = RHO * THK * AREA
95C
96 smass = amasu * area ! THK is already included in the input AMASU ( = MASS/AREA = RHO * THK)
97C nodal mass
98 ms(ibufn(1))=ms(ibufn(1)) + smass * fourth
99 ms(ibufn(2))=ms(ibufn(2)) + smass * fourth
100 ms(ibufn(3))=ms(ibufn(3)) + smass * fourth
101 ms(ibufn(4))=ms(ibufn(4)) + smass * fourth
102C
103 addmas = addmas + smass
104C
105 ELSE IF(ity == 7)THEN
106C----------------------------------------------
107C MASSES ELEMENTS * ANGLE
108C----------------------------------------------
109 x1=x(1,ibufn(1))
110 y1=x(2,ibufn(1))
111 z1=x(3,ibufn(1))
112 x2=x(1,ibufn(2))
113 y2=x(2,ibufn(2))
114 z2=x(3,ibufn(2))
115 x3=x(1,ibufn(3))
116 y3=x(2,ibufn(3))
117 z3=x(3,ibufn(3))
118C
119 x21=x2-x1
120 y21=y2-y1
121 z21=z2-z1
122 x31=x3-x1
123 y31=y3-y1
124 z31=z3-z1
125 x32=x3-x2
126 y32=y3-y2
127 z32=z3-z2
128C
129 a2 = x21**2 + y21**2 + z21**2
130 b2 = x32**2 + y32**2 + z32**2
131 c2 = x31**2 + y31**2 + z31**2
132 aa = sqrt(a2)
133 bb = sqrt(b2)
134 cc = sqrt(c2)
135C
136 ang1 = acos((a2 + c2 - b2)/(two * aa * cc)) / pi
137 ang2 = acos((a2 + b2 - c2)/(two * aa * bb)) / pi
138 ang3 = acos((b2 + c2 - a2)/(two * bb * cc)) / pi
139C
140 IF ( ( (a2 + c2 - b2)/(2. * aa * cc) <= -one ) .OR.
141 . ( (a2 + c2 - b2)/(2. * aa * cc) >= one ) .OR.
142 . ( (a2 + b2 - c2)/(2. * aa * bb) <= -one ) .OR.
143 . ( (a2 + b2 - c2)/(2. * aa * bb) >= one ) .OR.
144 . ( (b2 + c2 - a2)/(2. * bb * cc) <= -one ) .OR.
145 . ( (b2 + c2 - a2)/(2. * bb * cc) >= one ) ) THEN
146 CALL ancmsg(msgid=880,
147 . msgtype=msgerror,
148 . anmode=aninfo,
149 . i1=admid,
150 . c1=titr,i2=id)
151 ENDIF
152C
153 e3x=y21*z31-z21*y31
154 e3y=z21*x31-x21*z31
155 e3z=x21*y31-y21*x31
156 sum=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
157 area=half*sum
158C
159 smass = amasu * area
160C
161 ms(ibufn(1))=ms(ibufn(1)) + smass * ang1
162 ms(ibufn(2))=ms(ibufn(2)) + smass * ang2
163 ms(ibufn(3))=ms(ibufn(3)) + smass * ang3
164C
165C ADDMAS = ADDMAS + SMASS * (ANG1 + ANG2 + ANG3)
166C ANG1 + ANG2 + ANG3 = 1.
167 addmas = addmas + smass
168 END IF
169C=======================================================================
170 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
initmumps id
integer, parameter nchartitle
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889