OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i3sti3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C
24!||====================================================================
25!|| i3sti3 ../starter/source/interfaces/inter3d1/i3sti3.F
26!||--- called by ------------------------------------------------------
27!|| inint3 ../starter/source/interfaces/inter3d1/inint3.f
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| incoq3 ../starter/source/interfaces/inter3d1/incoq3.F
31!|| ineltc ../starter/source/interfaces/inter3d1/inelt.F
32!|| inelts ../starter/source/interfaces/inter3d1/inelt.F
33!|| insol3 ../starter/source/interfaces/inter3d1/insol3.F
34!|| local_index ../starter/source/interfaces/interf1/local_index.F
35!|| volint ../starter/source/interfaces/inter3d1/volint.F
36!||--- uses -----------------------------------------------------
37!|| message_mod ../starter/share/message_module/message_mod.F
38!||====================================================================
39 SUBROUTINE i3sti3(
40 1 X ,IRECT ,STF ,IXS ,PM ,
41 2 GEO ,NRT ,IXC ,STFN ,NSEG ,
42 3 LNSV ,NINT ,NSN ,NSV ,SLSFAC,
43 4 NTY ,GAP ,NOINT ,IXTG ,IR ,
44 5 KNOD2ELS ,KNOD2ELC ,KNOD2ELTG ,NOD2ELS ,NOD2ELC ,
45 6 NOD2ELTG ,IGRSURF ,THK ,IXS10 ,
46 7 IXS16 ,IXS20 ,ID,TITR ,GAPN ,STF8 ,
47 8 DEPTH ,FMAX ,IGEO ,FILLSOL ,PM_STACK,
48 9 IWORKSH )
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE message_mod
53 USE groupdef_mod
54 USE names_and_titles_mod , ONLY : nchartitle
55 use element_mod , only :nixs,nixc,nixtg
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com04_c.inc"
64#include "param_c.inc"
65#include "scr08_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER NRT, NINT, NSN, NTY, NOINT, IR
70 my_real
71 . SLSFAC, GAP
72 INTEGER IRECT(4,*), IXS(NIXS,*), IXC(NIXC,*),
73 . NSV(*), IXTG(NIXTG,*), NSEG(*), LNSV(*),
74 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
75 . NOD2ELTG(*),IXS10(*), IXS16(*), IXS20(*),
76 . IGEO(NPROPGI,*),IWORKSH(3,*)
77 my_real
78 . x(3,*), stf(*), pm(npropm,*), geo(npropg,*), stfn(*),thk(*),
79 . gapn(*),stf8(*) ,fmax, depth, fillsol(*),pm_stack(20,*)
80 INTEGER ID
81 CHARACTER(LEN=NCHARTITLE) :: TITR
82 TYPE (SURF_) :: IGRSURF
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER NDX, I, J, INRT, NELS, MT, JJ, JJJ, NELC,
87 . MG, NUM, NPT, LL, NELTG,IGTYP,IPGMAT,IGMAT,
88 . ISUBSTACK, IG, IL
89C REAL
90 my_real
91 . dxm, area, vol, dx,slope,stfmin
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95
96C--------------------------------------------------------------
97C CALCULATION OF THE STIFFNESSES OF THE SEGMENTS AND NODES
98C V16: IN CASE A SEGMENT BELONGS TO BOTH
99C A BRICK AND A SHELL, THE STIFFNESS OF THE SHELL IS CHOSEN
100C OF THE SHELL UNLESS THE SHELL MATERIAL IS NULL.
101C---------------------------------------------------------------
102 dxm=zero
103 ndx=0
104 ipgmat = 700
105C
106 IF (nty==8) THEN
107 gapn(1:nrt) = zero
108 stf8(1:nrt) = zero
109 ENDIF
110 stfmin = ep20
111C
112 DO i=1,nrt
113 stf(i)=zero
114 inrt=i
115C----------------------
116 CALL inelts(x ,irect,ixs ,nint,nels ,
117 . inrt ,area ,noint,ir ,igrsurf%ELTYP,
118 . igrsurf%ELEM)
119 IF(nels/=0)THEN
120 mt=ixs(1,nels)
121 IF(mt>0)THEN
122 DO jj=1,8
123 jjj=ixs(jj+1,nels)
124 xc(jj)=x(1,jjj)
125 yc(jj)=x(2,jjj)
126 zc(jj)=x(3,jjj)
127 END DO
128 CALL volint(vol)
129 stf(i)=slsfac*fillsol(nels)*area*area*pm(32,mt)/vol
130 stfmin = min(stfmin,stf(i))
131 ELSE
132 IF(nint>=0) THEN
133 CALL ancmsg(msgid=95,
134 . msgtype=msgwarning,
135 . anmode=aninfo_blind_2,
136 . i1=id,
137 . c1=titr,
138 . i2=ixs(nixs,nels),
139 . c2='SOLID',
140 . i3=i)
141 ENDIF
142 IF(nint<0) THEN
143 CALL ancmsg(msgid=96,
144 . msgtype=msgwarning,
145 . anmode=aninfo_blind_2,
146 . i1=id,
147 . c1=titr,
148 . i2=ixs(nixs,nels),
149 . c2='SOLID',
150 . i3=i)
151 ENDIF
152 ENDIF
153 GO TO 500
154 ELSE
155 CALL ineltc(nelc ,neltg ,inrt ,igrsurf%ELTYP, igrsurf%ELEM)
156
157 IF(neltg/=0) THEN
158 mt=ixtg(1,neltg)
159 mg=ixtg(5,neltg)
160 igtyp = igeo(11,mg)
161 igmat = igeo(98,mg)
162 dx=geo(1,mg)
163 IF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp ==52) dx = thk(numelc + neltg)
164 IF (nty==8) gapn(i) = dx/two
165 dxm=dxm+dx
166 ndx=ndx+1
167 IF(mt>0)THEN
168 IF( igtyp == 11 .AND. igmat > 0) THEN
169 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
170 stfmin = min(stfmin,stf(i))
171 ELSEIF(igtyp == 52 .OR.
172 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
173 isubstack = iworksh(3,numelc+neltg)
174 stf(i)=slsfac*dx*pm_stack(2,isubstack)
175 stfmin = min(stfmin,stf(i))
176 ELSE
177 stf(i)=slsfac*dx*pm(20,mt)
178 stfmin = min(stfmin,stf(i))
179 ENDIF
180 ELSE
181 IF(nint>=0) THEN
182 CALL ancmsg(msgid=95,
183 . msgtype=msgwarning,
184 . anmode=aninfo_blind_2,
185 . i1=id,
186 . c1=titr,
187 . i2=ixtg(nixtg,neltg),
188 . c2='SHELL',
189 . i3=i)
190 END IF
191 IF(nint<0) THEN
192 CALL ancmsg(msgid=96,
193 . msgtype=msgwarning,
194 . anmode=aninfo_blind_2,
195 . i1=id,
196 . c1=titr,
197 . i2=ixtg(nixtg,neltg),
198 . c2='SHELL',
199 . i3=i)
200 END IF
201 END IF
202 GO TO 500
203 ELSEIF(nelc/=0) THEN
204 mt=ixc(1,nelc)
205 mg=ixc(6,nelc)
206 igtyp = igeo(11,mg)
207 igmat = igeo(98,mg)
208 dx=geo(1,mg)
209 IF(igtyp == 17 .OR. igtyp == 51) dx = thk(nelc)
210 IF (nty==8) gapn(i) = dx/two
211 dxm=dxm+dx
212 ndx=ndx+1
213 IF(mt>0)THEN
214 IF(igtyp == 11 .AND. igmat > 0) THEN
215 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
216 stfmin = min(stfmin,stf(i))
217 ELSEIF(igtyp == 52 .OR.
218 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
219 isubstack = iworksh(3,nelc)
220 stf(i)=slsfac*dx*pm_stack(2 ,isubstack)
221 stfmin = min(stfmin,stf(i))
222 ELSE
223 stf(i)=slsfac*dx*pm(20,mt)
224 stfmin = min(stfmin,stf(i))
225 ENDIF
226 ELSE
227 IF(nint>=0) THEN
228 CALL ancmsg(msgid=95,
229 . msgtype=msgwarning,
230 . anmode=aninfo_blind_2,
231 . i1=id,
232 . c1=titr,
233 . i2=ixc(nixc,nelc),
234 . c2='SHELL',
235 . i3=i)
236 END IF
237 IF(nint<0) THEN
238 CALL ancmsg(msgid=96,
239 . msgtype=msgwarning,
240 . anmode=aninfo_blind_2,
241 . i1=id,
242 . c1=titr,
243 . i2=ixc(nixc,nelc),
244 . c2='SHELL',
245 . i3=i)
246 END IF
247 END IF
248 GO TO 500
249 END IF
250 END IF
251C----------------------
252C ELEMENTS SOLIDES
253C----------------------
254 CALL insol3(x,irect,ixs,nint,nels,inrt,
255 . area,noint,knod2els ,nod2els ,ir ,ixs10,
256 . ixs16,ixs20)
257 IF(nels/=0) THEN
258 mt=ixs(1,nels)
259 IF(mt>0)THEN
260 DO jj=1,8
261 jjj=ixs(jj+1,nels)
262 xc(jj)=x(1,jjj)
263 yc(jj)=x(2,jjj)
264 zc(jj)=x(3,jjj)
265 ENDDO
266 CALL volint(vol)
267 stf(i)=slsfac*fillsol(nels)*area*area*pm(32,mt)/vol
268 stfmin = min(stfmin,stf(i))
269 ELSE
270 IF(nint>=0) THEN
271 CALL ancmsg(msgid=95,
272 . msgtype=msgwarning,
273 . anmode=aninfo_blind_2,
274 . i1=id,
275 . c1=titr,
276 . i2=ixs(nixs,nels),
277 . c2='SOLID',
278 . i3=i)
279 ENDIF
280 IF(nint<0) THEN
281 CALL ancmsg(msgid=96,
282 . msgtype=msgwarning,
283 . anmode=aninfo_blind_2,
284 . i1=id,
285 . c1=titr,
286 . i2=ixs(nixs,nels),
287 . c2='SOLID',
288 . i3=i)
289 ENDIF
290 ENDIF
291 ENDIF
292C---------------------
293C ELEMENTS COQUES
294C---------------------
295 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
296 . neltg,inrt,geo ,pm ,knod2elc ,
297 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
298 . pm_stack , iworksh)
299 IF(neltg/=0) THEN
300 mt=ixtg(1,neltg)
301 mg=ixtg(5,neltg)
302 igtyp = igeo(11,mg)
303 igmat = igeo(98,mg)
304 dx=geo(1,mg)
305 IF(igtyp == 17 .OR. igtyp == 51) dx = thk(nelc)
306 IF (nty==8) gapn(i) = dx/two
307 dxm=dxm+dx
308 ndx=ndx+1
309 IF(mt>0)THEN
310 IF(igtyp == 11 .AND. igmat > 0) THEN
311 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
312 stfmin = min(stfmin,stf(i))
313 ELSEIF(igtyp == 52 .OR.
314 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
315 isubstack = iworksh(3,nelc)
316 stf(i)=slsfac*dx*pm_stack(2 ,isubstack)
317 stfmin = min(stfmin,stf(i))
318 ELSE
319 stf(i)=slsfac*dx*pm(20,mt)
320 stfmin = min(stfmin,stf(i))
321 ENDIF
322 ELSE
323 IF(nint>=0) THEN
324 CALL ancmsg(msgid=95,
325 . msgtype=msgwarning,
326 . anmode=aninfo_blind_2,
327 . i1=id,
328 . c1=titr,
329 . i2=ixtg(nixtg,neltg),
330 . c2='SHELL',
331 . i3=i)
332 ENDIF
333 IF(nint<0) THEN
334 CALL ancmsg(msgid=95,
335 . msgtype=msgwarning,
336 . anmode=aninfo_blind_2,
337 . i1=id,
338 . c1=titr,
339 . i2=ixtg(nixtg,neltg),
340 . c2='SHELL',
341 . i3=i)
342 ENDIF
343 ENDIF
344 ELSEIF(nelc/=0) THEN
345 mt=ixc(1,nelc)
346 mg=ixc(6,nelc)
347 igtyp = igeo(11,mg)
348 igmat = igeo(98,mg)
349 dx=geo(1,mg)
350 IF(igtyp == 17 .OR. igtyp == 51) dx = thk(nelc)
351 IF (nty==8) gapn(i) = dx/two
352 dxm=dxm+dx
353 ndx=ndx+1
354 IF(mt>0)THEN
355 IF(igtyp == 11 .AND. igmat > 0) THEN
356 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
357 stfmin = min(stfmin,stf(i))
358 ELSEIF(igtyp == 52 .OR.
359 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
360 isubstack = iworksh(3,nelc)
361 stf(i)=slsfac*dx*pm_stack(2 ,isubstack)
362 stfmin = min(stfmin,stf(i))
363 ELSE
364 stf(i)=slsfac*dx*pm(20,mt)
365 stfmin = min(stfmin,stf(i))
366 ENDIF
367 ELSE
368 IF(nint>=0) THEN
369 CALL ancmsg(msgid=95,
370 . msgtype=msgwarning,
371 . anmode=aninfo_blind_2,
372 . i1=id,
373 . c1=titr,
374 . i2=ixc(nixc,nelc),
375 . c2='SHELL',
376 . i3=i)
377 ENDIF
378 IF(nint<0) THEN
379 CALL ancmsg(msgid=95,
380 . msgtype=msgwarning,
381 . anmode=aninfo_blind_2,
382 . i1=id,
383 . c1=titr,
384 . i2=ixc(nixc,nelc),
385 . c2='SHELL',
386 . i3=i)
387 ENDIF
388 ENDIF
389 ENDIF
390C
391 IF(nels+nelc+neltg==0)THEN
392 IF(nint>0) THEN
393 CALL ancmsg(msgid=92,
394 . msgtype=msgwarning,
395 . anmode=aninfo_blind_2,
396 . i1=id,
397 . c1=titr,
398 . i2=i)
399 ENDIF
400 IF(nint<0) THEN
401 CALL ancmsg(msgid=93,
402 . msgtype=msgwarning,
403 . anmode=aninfo_blind_2,
404 . i1=id,
405 . c1=titr,
406 . i2=i)
407 ENDIF
408 ENDIF
409 500 CONTINUE
410 ENDDO !I=1,NRT
411C---------------------------
412C Stiffness INTERFACES TYPE 8
413C---------------------------
414 IF(nty==8)THEN
415 IF(fmax/=zero) THEN
416 IF(depth<=em20) THEN
417 DO i=1,nrt
418 stf8(i) = stf(i)
419 ENDDO
420 CALL ancmsg(msgid=1043,
421 . msgtype=msgwarning,
422 . anmode=aninfo_blind_2,
423 . i1=id,
424 . c1=titr,
425 . r1=depth)
426 ELSE
427 slope = fmax/depth
428 IF(slope>stfmin.AND.stfmin/=zero)THEN
429 DO i=1,nrt
430 stf8(i) = stf(i)
431 ENDDO
432 CALL ancmsg(msgid=1040,
433 . msgtype=msgwarning,
434 . anmode=aninfo_blind_2,
435 . i1=id,
436 . c1=titr,
437 . r1=depth,
438 . r2=fmax,
439 . r3=slope)
440 ELSE
441 DO i=1,nrt
442 stf8(i) = slope
443 ENDDO
444 ENDIF
445 ENDIF
446 ENDIF
447 ENDIF
448C---------------------------------------------
449C CALCULATION OF NODE STIFFNESSES
450C---------------------------------------------
451 DO j=1,nsn
452 num=nseg(j+1)-nseg(j)
453 npt=nseg(j)-1
454 DO jj=1,num
455 ll=lnsv(npt+jj)
456 stfn(j)=stfn(j)+fourth*stf(ll)
457 ENDDO
458 ENDDO
459C
460 DO i=1,nrt
461 DO j=1,4
462 ig=irect(j,i)
463 CALL local_index(il,ig,nsv,nsn)
464 irect(j,i)=il
465 ENDDO
466 ENDDO
467C
468 RETURN
469 END
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i3sti3
subroutine i3sti3(x, irect, stf, ixs, pm, geo, nrt, ixc, stfn, nseg, lnsv, nint, nsn, nsv, slsfac, nty, gap, noint, ixtg, ir, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, thk, ixs10, ixs16, ixs20, id, titr, gapn, stf8, depth, fmax, igeo, fillsol, pm_stack, iworksh)
Definition i3sti3.F:49
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:46
inelts
subroutine inelts(x, irect, ixs, nint, nel, i, area, noint, ir, surf_eltyp, surf_elem)
Definition inelt.F:40
ineltc
subroutine ineltc(nelc, neltg, is, surf_eltyp, surf_elem)
Definition inelt.F:134
inint3
subroutine inint3(inscr, x, ixs, ixc, pm, geo, ipari, nin, itab, ms, mwa, rwa, ixtg, iwrn, ikine, ixt, ixp, ixr, nelemint, iddlevel, ifiend, ale_connectivity, nsnet, nmnet, igrbric, iwcont, nsnt, nmnt, nsn2t, nmn2t, iwcin2, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ikine1, ielem21, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, nod2el1d, knod2el1d, ixs10, i_mem, resort, inter_cand, ixs16, ixs20, id, titr, iremnode, nremnode, iparts, kxx, ixx, igeo, intercep, lelx, intbuf_tab, fillsol, stack, iworksh, kxig3d, ixig3d, tagprt_fric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, nsn_multi_connec, t2_add_connec, t2_nb_connec, t2_connec, nom_opt, icode, iskew, iremnode_edg, s_append_array, x_append, mass_append, n2d, flag_removed_node, nspmd, inter_type2_number, elem_linked_to_segment, sinscr, sicode, sitab, nin25, flag_elem_inter25, multi_fvm, iresp)
Definition inint3.F:147
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:44
local_index
subroutine local_index(il, ig, nodes, n)
Definition local_index.F:37
min
#define min(a, b)
Definition macros.h:20
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
ancmsg
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:895
starter
program starter
Definition starter.F:39
volint
subroutine volint(vol)
Definition volint.F:38