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

Go to the source code of this file.

Functions/Subroutines

subroutine mmodul (jft, jlt, pm, mat, mtn, gama, uparam, cc, cg, g33, mat_param)

Function/Subroutine Documentation

◆ mmodul()

subroutine mmodul ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
integer mtn,
gama,
uparam,
cc,
cg,
g33,
type(matparam_struct_), intent(in) mat_param )

Definition at line 34 of file mmodul.F.

37! ---------------------------------------------------------------------------------
38! modules
39! ---------------------------------------------------------------------------------
40 use matparam_def_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "param_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER JFT, JLT ,MTN
57 INTEGER MAT(*)
58C REAL
59 my_real
60 . pm(npropm,*),cc(mvsiz,3,3),uparam(*),
61 . gama(mvsiz,6),cg(mvsiz,3,3),g33(mvsiz,3,3)
62 type(matparam_struct_) , intent(in) :: mat_param
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,MX,IAD,J,K,ipr,NBDAMA
67C REAL
68 my_real
69 . nu,lamda,gg,c1,qc(mvsiz,9),qcg(mvsiz,9),qg(mvsiz,9),
70 . qgc(mvsiz,9),g3(mvsiz,3),tt,tv,ca,cb,cn,
71 . s1,nu12,nu21,efac,arma,arm1,arm2,arm3,et24
72 my_real
73 . cc24(mvsiz,3,3),c3(mvsiz,3)
74C-----------------------------------------------
75 CALL gettransv(jft,jlt,gama,qc,qcg,qgc,qg)
76 IF (mtn==14.OR.mtn==12) THEN
77 DO i=jft,jlt
78 mx =mat(i)
79 cc(i,1,1) =pm(40,mx)
80 cc(i,2,2) =pm(43,mx)
81 cc(i,3,3) =pm(45,mx)
82 cc(i,1,2) =pm(41,mx)
83 cc(i,2,3) =pm(44,mx)
84 cc(i,1,3) =pm(42,mx)
85 g3(i,1) =pm(46,mx)
86 g3(i,2) =pm(47,mx)
87 g3(i,3) =pm(48,mx)
88 ENDDO
89 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
90 . qg ,cc ,g3 ,g33 ,cg )
91 ELSEIF (mtn==24) THEN
92 mx =mat(1)
93C-------ET24 for the moment is elastic, could be set more precisely
94 et24 = pm(50,mx)
95 arm1 = pm(53,mx)
96 arm2 = pm(54,mx)
97 arm3 = pm(55,mx)
98 arma = arm1 + arm2 + arm3
99 gg = pm(22,mx)
100 tt = pm(24,mx)
101 tv = pm(25,mx)
102C-------damages are negliged for increment (consisting to isotropic case )
103C-----will apply the dommage to generalized stress
104 DO i=jft,jlt
105 cc(i,1,1) = tt
106 cc(i,2,2) = tt
107 cc(i,3,3) = tt
108 cc(i,1,2) = tv
109 cc(i,2,3) = tv
110 cc(i,1,3) = tv
111 cc(i,2,1) = tv
112 cc(i,3,2) = tv
113 cc(i,3,1) = tv
114c
115 g3(i,1:3)= gg
116 END DO
117 IF (arma>zero) THEN
118C--------assemble the two parts in reinforced system
119 DO i=jft,jlt
120 c3(i,1) =(one-arm1)*cc(i,1,1)+et24*arm1
121 c3(i,2) =(one-arm2)*cc(i,2,2)+et24*arm2
122 c3(i,3) =(one-arm3)*cc(i,3,3)+et24*arm3
123 ENDDO
124C--------translate C3 to elem sys--(CC24,G33 ,CG)
125 CALL c33stif2el(jlt ,qc ,qcg ,qgc ,qg ,
126 . c3 ,cc24 ,g33 ,cg )
127C--------final assemblage ----
128 DO j = 1,3
129 DO i=jft,jlt
130 cc(i,j,j) =cc24(i,j,j)
131 g33(i,j,j)=g33(i,j,j)+g3(i,j)
132 ENDDO
133 ENDDO
134 DO i=jft,jlt
135 cc(i,1,2) = cc(i,1,2) + cc24(i,1,2)
136 cc(i,1,3) = cc(i,1,3) + cc24(i,1,3)
137 cc(i,2,3) = cc(i,2,3) + cc24(i,2,3)
138 cc(i,2,1) = cc(i,1,2)
139 cc(i,3,1) = cc(i,1,3)
140 cc(i,3,2) = cc(i,2,3)
141 ENDDO
142 ELSE
143C----- w/o armature :--> isotropic
144 DO i=jft,jlt
145 g33(i,1,1) = gg
146 g33(i,2,2) = g33(i,1,1)
147 g33(i,3,3) = g33(i,1,1)
148 g33(i,1,2) = zero
149 g33(i,2,3) = zero
150 g33(i,1,3) = zero
151 g33(i,2,1) = zero
152 g33(i,3,2) = zero
153 g33(i,3,1) = zero
154 cg(i,1:3,1:3)=zero
155 ENDDO
156 END IF
157 ELSEIF (mtn==25) THEN
158 DO i=jft,jlt
159 mx =mat(i)
160 nu12 =pm(35,mx)
161 nu21 =pm(36,mx)
162 s1 = one-nu12*nu21
163 cc(i,1,1) =pm(33,mx)/max(em20,s1)
164 cc(i,2,2) =pm(34,mx)/max(em20,s1)
165 cc(i,3,3) =pm(186,mx)
166 cc(i,1,2) =half*(nu21*cc(i,1,1)+nu12*cc(i,2,2))
167 cc(i,2,3) =zero
168 cc(i,1,3) =zero
169 g3(i,1) =pm(37,mx)
170 g3(i,2) =pm(38,mx)
171 g3(i,3) =pm(39,mx)
172 ENDDO
173 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
174 . qg ,cc ,g3 ,g33 ,cg )
175 ELSEIF (mtn==28.OR.mtn==68) THEN
176 DO i=jft,jlt
177 mx =mat(i)
178 cc(i,1,1) = uparam(1)
179 cc(i,2,2) = uparam(2)
180 cc(i,3,3) = uparam(3)
181 cc(i,1,2) = zero
182 cc(i,2,3) = zero
183 cc(i,1,3) = zero
184 g3(i,1) = uparam(4)
185 g3(i,2) = uparam(5)
186 g3(i,3) = uparam(6)
187 ENDDO
188 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
189 . qg ,cc ,g3 ,g33 ,cg )
190 ELSEIF (mtn == 50) THEN
191 DO i=jft,jlt
192 cc(i,1,1) = mat_param%uparam(1)
193 cc(i,2,2) = mat_param%uparam(2)
194 cc(i,3,3) = mat_param%uparam(3)
195 cc(i,1,2) = zero
196 cc(i,2,3) = zero
197 cc(i,1,3) = zero
198 g3(i,1) = mat_param%uparam(4)
199 g3(i,2) = mat_param%uparam(5)
200 g3(i,3) = mat_param%uparam(6)
201 ENDDO
202 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
203 . qg ,cc ,g3 ,g33 ,cg )
204 ELSEIF (mtn==53) THEN
205 DO i=jft,jlt
206 mx =mat(i)
207 cc(i,1,1) = uparam(1)
208 cc(i,2,2) = uparam(2)
209 cc(i,3,3) = cc(i,2,2)
210 cc(i,1,2) = zero
211 cc(i,2,3) = zero
212 cc(i,1,3) = zero
213 g3(i,1) = uparam(3)
214 g3(i,2) = uparam(4)
215 g3(i,3) = g3(i,1)
216 ENDDO
217 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
218 . qg ,cc ,g3 ,g33 ,cg )
219 ELSEIF (mtn == 93) THEN
220 DO i=jft,jlt
221 mx =mat(i)
222 cc(i,1,1) = uparam(4)
223 cc(i,2,2) = uparam(7)
224 cc(i,3,3) = uparam(9)
225 cc(i,1,2) = uparam(5)
226 cc(i,2,3) = uparam(8)
227 cc(i,1,3) = uparam(6)
228 g3(i,1) = uparam(10)
229 g3(i,2) = uparam(11)
230 g3(i,3) = uparam(12)
231 ENDDO
232 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
233 . qg ,cc ,g3 ,g33 ,cg )
234 ELSEIF (mtn==107) THEN
235 DO i=jft,jlt
236 mx = mat(i)
237 nu12 = uparam(4)
238 nu21 = uparam(5)
239 s1 = one-nu12*nu21
240 cc(i,1,1) =uparam(1)/max(em20,s1)
241 cc(i,2,2) =uparam(2)/max(em20,s1)
242 cc(i,3,3) =uparam(3)
243 cc(i,1,2) =half*(nu21*cc(i,1,1)+nu12*cc(i,2,2))
244 cc(i,2,3) =zero
245 cc(i,1,3) =zero
246 g3(i,1) = uparam(10)
247 g3(i,2) = uparam(11)
248 g3(i,3) = uparam(12)
249 ENDDO
250 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
251 . qg ,cc ,g3 ,g33 ,cg )
252 ELSEIF (mtn==112) THEN
253 DO i=jft,jlt
254 mx = mat(i)
255 nu12 = uparam(4)
256 nu21 = uparam(5)
257 s1 = one-nu12*nu21
258 cc(i,1,1) =uparam(1)/max(em20,s1)
259 cc(i,2,2) =uparam(2)/max(em20,s1)
260 cc(i,3,3) =uparam(3)
261 cc(i,1,2) =half*(nu21*cc(i,1,1)+nu12*cc(i,2,2))
262 cc(i,2,3) =zero
263 cc(i,1,3) =zero
264 g3(i,1) = uparam(10)
265 g3(i,2) = uparam(11)
266 g3(i,3) = uparam(12)
267 ENDDO
268 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
269 . qg ,cc ,g3 ,g33 ,cg )
270 ELSEIF (mtn == 122) THEN
271 DO i=jft,jlt
272 cc(i,1,1) = uparam(58)
273 cc(i,2,2) = uparam(61)
274 cc(i,3,3) = uparam(63)
275 cc(i,1,2) = uparam(59)
276 cc(i,2,3) = uparam(62)
277 cc(i,1,3) = uparam(60)
278 g3(i,1) = uparam(10)
279 g3(i,2) = uparam(11)
280 g3(i,3) = uparam(12)
281 ENDDO
282 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
283 . qg ,cc ,g3 ,g33 ,cg )
284 ELSEIF (mtn == 127) THEN
285 DO i=jft,jlt
286 cc(i,1,1) = mat_param%uparam(41)
287 cc(i,2,2) = mat_param%uparam(42)
288 cc(i,3,3) = mat_param%uparam(43)
289 cc(i,1,2) = mat_param%uparam(44)
290 cc(i,2,3) = mat_param%uparam(46)
291 cc(i,1,3) = mat_param%uparam(45)
292 g3(i,1) = mat_param%uparam(47)
293 g3(i,2) = mat_param%uparam(48)
294 g3(i,3) = mat_param%uparam(49)
295 ENDDO
296 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
297 . qg ,cc ,g3 ,g33 ,cg )
298
299 ELSEIF (mtn == 128) THEN
300 nu = mat_param%NU
301 lamda = three*nu*mat_param%BULK/(one+nu)
302 DO i=jft,jlt
303 cc(i,1,1) = lamda + two*mat_param%SHEAR
304 cc(i,2,2) = cc(i,1,1)
305 cc(i,3,3) = cc(i,1,1)
306 cc(i,1,2) = lamda
307 cc(i,2,3) = lamda
308 cc(i,1,3) = lamda
309 g3(i,1) = mat_param%SHEAR
310 g3(i,2) = mat_param%SHEAR
311 g3(i,3) = mat_param%SHEAR
312 ENDDO
313 CALL mstiforthv(jft ,jlt ,qc ,qcg ,qgc ,
314 . qg ,cc ,g3 ,g33 ,cg )
315
316 ELSE
317C----------warring out isotrope effective
318 DO i=jft,jlt
319 mx =mat(i)
320 nu =pm(21,mx)
321 c1 =three*pm(32,mx)/(one+nu)
322 lamda=c1*nu
323C-------GG:2G---HH(2,I):G-------
324 gg =c1*(one-two*nu)
325 cc(i,1,1) = lamda+gg
326 cc(i,2,2) = cc(i,1,1)
327 cc(i,3,3) = cc(i,1,1)
328 cc(i,1,2) = lamda
329 cc(i,2,3) = lamda
330 cc(i,1,3) = lamda
331 cc(i,2,1) = lamda
332 cc(i,3,2) = lamda
333 cc(i,3,1) = lamda
334c
335 g33(i,1,1) = gg*half
336 g33(i,2,2) = g33(i,1,1)
337 g33(i,3,3) = g33(i,1,1)
338 g33(i,1,2) = zero
339 g33(i,2,3) = zero
340 g33(i,1,3) = zero
341 g33(i,2,1) = zero
342 g33(i,3,2) = zero
343 g33(i,3,1) = zero
344C
345 cg(i,1:3,1:3)=zero
346 ENDDO
347 ENDIF
348
349C
350 RETURN
c33stif2el
subroutine c33stif2el(nel, qc, qcg, qgc, qg, c33, cc, g33, cg)
Definition c33stif2el.F:32
cg
subroutine cg(dim, mat, rhs, sol, max_iter, tol)
Definition conjugate_gradient.F:29
my_real
#define my_real
Definition cppsort.cpp:32
gettransv
subroutine gettransv(jft, jlt, gama, qc, qcg, qgc, qg)
Definition gettransv.F:31
max
#define max(a, b)
Definition macros.h:21
mstiforthv
subroutine mstiforthv(jft, jlt, qc, qcg, qgc, qg, cc, g3, g33, cg)
Definition mstiforthv.F:32