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
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com04_c.inc"
63#include "param_c.inc"
64#include "scr08_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER NRT, NINT, NSN, NTY, NOINT, IR
69 my_real
70 . SLSFAC, GAP
71 INTEGER IRECT(4,*), IXS(NIXS,*), IXC(NIXC,*),
72 . NSV(*), IXTG(NIXTG,*), NSEG(*), LNSV(*),
73 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
74 . NOD2ELTG(*),IXS10(*), IXS16(*), IXS20(*),
75 . IGEO(NPROPGI,*),IWORKSH(3,*)
76 my_real
77 . x(3,*), stf(*), pm(npropm,*), geo(npropg,*), stfn(*),thk(*),
78 . gapn(*),stf8(*) ,fmax, depth, fillsol(*),pm_stack(20,*)
79 INTEGER ID
80 CHARACTER(LEN=NCHARTITLE) :: TITR
81 TYPE (SURF_) :: IGRSURF
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER NDX, I, J, INRT, NELS, MT, JJ, JJJ, NELC,
86 . MG, NUM, NPT, LL, L, NELTG,IGTYP,IPGMAT,IGMAT,
87 . ISUBSTACK, IG, IL
88C REAL
89 my_real
90 . dxm, area, vol, dx, gaptmp,slope,stfmin
91C-----------------------------------------------
92C E x t e r n a l F u n c t i o n s
93C-----------------------------------------------
94
95C--------------------------------------------------------------
96C CALCUL DES RIGIDITES DES SEGMENTS ET DES NOEUDS
97C V16 : DANS LE CAS OU ONE SEGMENT APPARTIENT A LA FOIS
98C A UNE BRIQUE ET A UNE COQUE ON CHOISIT LA RIGIDITE
99C DE LA COQUE SAUF SI LE MATERIAU COQUE EST NUL.
100C---------------------------------------------------------------
101 dxm=zero
102 ndx=0
103 ipgmat = 700
104C
105 IF (nty==8) THEN
106 gapn(1:nrt) = zero
107 stf8(1:nrt) = zero
108 ENDIF
109 stfmin = ep20
110C
111 DO i=1,nrt
112 stf(i)=zero
113 inrt=i
114C----------------------
115 CALL inelts(x ,irect,ixs ,nint,nels ,
116 . inrt ,area ,noint,ir ,igrsurf%ELTYP,
117 . igrsurf%ELEM)
118 IF(nels/=0)THEN
119 mt=ixs(1,nels)
120 IF(mt>0)THEN
121 DO jj=1,8
122 jjj=ixs(jj+1,nels)
123 xc(jj)=x(1,jjj)
124 yc(jj)=x(2,jjj)
125 zc(jj)=x(3,jjj)
126 END DO
127 CALL volint(vol)
128 stf(i)=slsfac*fillsol(nels)*area*area*pm(32,mt)/vol
129 stfmin = min(stfmin,stf(i))
130 ELSE
131 IF(nint>=0) THEN
132 CALL ancmsg(msgid=95,
133 . msgtype=msgwarning,
134 . anmode=aninfo_blind_2,
135 . i1=id,
136 . c1=titr,
137 . i2=ixs(nixs,nels),
138 . c2='SOLID',
139 . i3=i)
140 ENDIF
141 IF(nint<0) THEN
142 CALL ancmsg(msgid=96,
143 . msgtype=msgwarning,
144 . anmode=aninfo_blind_2,
145 . i1=id,
146 . c1=titr,
147 . i2=ixs(nixs,nels),
148 . c2='SOLID',
149 . i3=i)
150 ENDIF
151 ENDIF
152 GO TO 500
153 ELSE
154 CALL ineltc(nelc ,neltg ,inrt ,igrsurf%ELTYP, igrsurf%ELEM)
155
156 IF(neltg/=0) THEN
157 mt=ixtg(1,neltg)
158 mg=ixtg(5,neltg)
159 igtyp = igeo(11,mg)
160 igmat = igeo(98,mg)
161 dx=geo(1,mg)
162 IF(igtyp == 17 .OR. igtyp == 51 .OR. igtyp ==52) dx = thk(numelc + neltg)
163 IF (nty==8) gapn(i) = dx/two
164 dxm=dxm+dx
165 ndx=ndx+1
166 IF(mt>0)THEN
167 IF( igtyp == 11 .AND. igmat > 0) THEN
168 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
169 stfmin = min(stfmin,stf(i))
170 ELSEIF(igtyp == 52 .OR.
171 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
172 isubstack = iworksh(3,numelc+neltg)
173 stf(i)=slsfac*dx*pm_stack(2,isubstack)
174 stfmin = min(stfmin,stf(i))
175 ELSE
176 stf(i)=slsfac*dx*pm(20,mt)
177 stfmin = min(stfmin,stf(i))
178 ENDIF
179 ELSE
180 IF(nint>=0) THEN
181 CALL ancmsg(msgid=95,
182 . msgtype=msgwarning,
183 . anmode=aninfo_blind_2,
184 . i1=id,
185 . c1=titr,
186 . i2=ixtg(nixtg,neltg),
187 . c2='SHELL',
188 . i3=i)
189 END IF
190 IF(nint<0) THEN
191 CALL ancmsg(msgid=96,
192 . msgtype=msgwarning,
193 . anmode=aninfo_blind_2,
194 . i1=id,
195 . c1=titr,
196 . i2=ixtg(nixtg,neltg),
197 . c2='SHELL',
198 . i3=i)
199 END IF
200 END IF
201 GO TO 500
202 ELSEIF(nelc/=0) THEN
203 mt=ixc(1,nelc)
204 mg=ixc(6,nelc)
205 igtyp = igeo(11,mg)
206 igmat = igeo(98,mg)
207 dx=geo(1,mg)
208 IF(igtyp == 17 .OR. igtyp == 51) dx = thk(nelc)
209 IF (nty==8) gapn(i) = dx/two
210 dxm=dxm+dx
211 ndx=ndx+1
212 IF(mt>0)THEN
213 IF(igtyp == 11 .AND. igmat > 0) THEN
214 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
215 stfmin = min(stfmin,stf(i))
216 ELSEIF(igtyp == 52 .OR.
217 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
218 isubstack = iworksh(3,nelc)
219 stf(i)=slsfac*dx*pm_stack(2 ,isubstack)
220 stfmin = min(stfmin,stf(i))
221 ELSE
222 stf(i)=slsfac*dx*pm(20,mt)
223 stfmin = min(stfmin,stf(i))
224 ENDIF
225 ELSE
226 IF(nint>=0) THEN
227 CALL ancmsg(msgid=95,
228 . msgtype=msgwarning,
229 . anmode=aninfo_blind_2,
230 . i1=id,
231 . c1=titr,
232 . i2=ixc(nixc,nelc),
233 . c2='SHELL',
234 . i3=i)
235 END IF
236 IF(nint<0) THEN
237 CALL ancmsg(msgid=96,
238 . msgtype=msgwarning,
239 . anmode=aninfo_blind_2,
240 . i1=id,
241 . c1=titr,
242 . i2=ixc(nixc,nelc),
243 . c2='SHELL',
244 . i3=i)
245 END IF
246 END IF
247 GO TO 500
248 END IF
249 END IF
250C----------------------
251C ELEMENTS SOLIDES
252C----------------------
253 CALL insol3(x,irect,ixs,nint,nels,inrt,
254 . area,noint,knod2els ,nod2els ,ir ,ixs10,
255 . ixs16,ixs20)
256 IF(nels/=0) THEN
257 mt=ixs(1,nels)
258 IF(mt>0)THEN
259 DO jj=1,8
260 jjj=ixs(jj+1,nels)
261 xc(jj)=x(1,jjj)
262 yc(jj)=x(2,jjj)
263 zc(jj)=x(3,jjj)
264 ENDDO
265 CALL volint(vol)
266 stf(i)=slsfac*fillsol(nels)*area*area*pm(32,mt)/vol
267 stfmin = min(stfmin,stf(i))
268 ELSE
269 IF(nint>=0) THEN
270 CALL ancmsg(msgid=95,
271 . msgtype=msgwarning,
272 . anmode=aninfo_blind_2,
273 . i1=id,
274 . c1=titr,
275 . i2=ixs(nixs,nels),
276 . c2='SOLID',
277 . i3=i)
278 ENDIF
279 IF(nint<0) THEN
280 CALL ancmsg(msgid=96,
281 . msgtype=msgwarning,
282 . anmode=aninfo_blind_2,
283 . i1=id,
284 . c1=titr,
285 . i2=ixs(nixs,nels),
286 . c2='SOLID',
287 . i3=i)
288 ENDIF
289 ENDIF
290 ENDIF
291C---------------------
292C ELEMENTS COQUES
293C---------------------
294 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
295 . neltg,inrt,geo ,pm ,knod2elc ,
296 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
297 . pm_stack , iworksh)
298 IF(neltg/=0) THEN
299 mt=ixtg(1,neltg)
300 mg=ixtg(5,neltg)
301 igtyp = igeo(11,mg)
302 igmat = igeo(98,mg)
303 dx=geo(1,mg)
304 IF(igtyp == 17 .OR. igtyp == 51) dx = thk(nelc)
305 IF (nty==8) gapn(i) = dx/two
306 dxm=dxm+dx
307 ndx=ndx+1
308 IF(mt>0)THEN
309 IF(igtyp == 11 .AND. igmat > 0) THEN
310 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
311 stfmin = min(stfmin,stf(i))
312 ELSEIF(igtyp == 52 .OR.
313 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
314 isubstack = iworksh(3,nelc)
315 stf(i)=slsfac*dx*pm_stack(2 ,isubstack)
316 stfmin = min(stfmin,stf(i))
317 ELSE
318 stf(i)=slsfac*dx*pm(20,mt)
319 stfmin = min(stfmin,stf(i))
320 ENDIF
321 ELSE
322 IF(nint>=0) THEN
323 CALL ancmsg(msgid=95,
324 . msgtype=msgwarning,
325 . anmode=aninfo_blind_2,
326 . i1=id,
327 . c1=titr,
328 . i2=ixtg(nixtg,neltg),
329 . c2='SHELL',
330 . i3=i)
331 ENDIF
332 IF(nint<0) THEN
333 CALL ancmsg(msgid=95,
334 . msgtype=msgwarning,
335 . anmode=aninfo_blind_2,
336 . i1=id,
337 . c1=titr,
338 . i2=ixtg(nixtg,neltg),
339 . c2='SHELL',
340 . i3=i)
341 ENDIF
342 ENDIF
343 ELSEIF(nelc/=0) THEN
344 mt=ixc(1,nelc)
345 mg=ixc(6,nelc)
346 igtyp = igeo(11,mg)
347 igmat = igeo(98,mg)
348 dx=geo(1,mg)
349 IF(igtyp == 17 .OR. igtyp == 51) dx = thk(nelc)
350 IF (nty==8) gapn(i) = dx/two
351 dxm=dxm+dx
352 ndx=ndx+1
353 IF(mt>0)THEN
354 IF(igtyp == 11 .AND. igmat > 0) THEN
355 stf(i)=slsfac*dx*geo(ipgmat + 2 ,mg)
356 stfmin = min(stfmin,stf(i))
357 ELSEIF(igtyp == 52 .OR.
358 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
359 isubstack = iworksh(3,nelc)
360 stf(i)=slsfac*dx*pm_stack(2 ,isubstack)
361 stfmin = min(stfmin,stf(i))
362 ELSE
363 stf(i)=slsfac*dx*pm(20,mt)
364 stfmin = min(stfmin,stf(i))
365 ENDIF
366 ELSE
367 IF(nint>=0) THEN
368 CALL ancmsg(msgid=95,
369 . msgtype=msgwarning,
370 . anmode=aninfo_blind_2,
371 . i1=id,
372 . c1=titr,
373 . i2=ixc(nixc,nelc),
374 . c2='SHELL',
375 . i3=i)
376 ENDIF
377 IF(nint<0) THEN
378 CALL ancmsg(msgid=95,
379 . msgtype=msgwarning,
380 . anmode=aninfo_blind_2,
381 . i1=id,
382 . c1=titr,
383 . i2=ixc(nixc,nelc),
384 . c2='SHELL',
385 . i3=i)
386 ENDIF
387 ENDIF
388 ENDIF
389C
390 IF(nels+nelc+neltg==0)THEN
391 IF(nint>0) THEN
392 CALL ancmsg(msgid=92,
393 . msgtype=msgwarning,
394 . anmode=aninfo_blind_2,
395 . i1=id,
396 . c1=titr,
397 . i2=i)
398 ENDIF
399 IF(nint<0) THEN
400 CALL ancmsg(msgid=93,
401 . msgtype=msgwarning,
402 . anmode=aninfo_blind_2,
403 . i1=id,
404 . c1=titr,
405 . i2=i)
406 ENDIF
407 ENDIF
408 500 CONTINUE
409 ENDDO !I=1,NRT
410C---------------------------
411C Stiffness INTERFACES TYPE 8
412C---------------------------
413 IF(nty==8)THEN
414 IF(fmax/=zero) THEN
415 IF(depth<=em20) THEN
416 DO i=1,nrt
417 stf8(i) = stf(i)
418 ENDDO
419 CALL ancmsg(msgid=1043,
420 . msgtype=msgwarning,
421 . anmode=aninfo_blind_2,
422 . i1=id,
423 . c1=titr,
424 . r1=depth)
425 ELSE
426 slope = fmax/depth
427 IF(slope>stfmin.AND.stfmin/=zero)THEN
428 DO i=1,nrt
429 stf8(i) = stf(i)
430 ENDDO
431 CALL ancmsg(msgid=1040,
432 . msgtype=msgwarning,
433 . anmode=aninfo_blind_2,
434 . i1=id,
435 . c1=titr,
436 . r1=depth,
437 . r2=fmax,
438 . r3=slope)
439 ELSE
440 DO i=1,nrt
441 stf8(i) = slope
442 ENDDO
443 ENDIF
444 ENDIF
445 ENDIF
446 ENDIF
447C---------------------------------------------
448C CALCUL DES RIGIDITES NODALES
449C---------------------------------------------
450 DO j=1,nsn
451 num=nseg(j+1)-nseg(j)
452 npt=nseg(j)-1
453 DO jj=1,num
454 ll=lnsv(npt+jj)
455 stfn(j)=stfn(j)+fourth*stf(ll)
456 ENDDO
457 ENDDO
458C
459 DO i=1,nrt
460 DO j=1,4
461 ig=irect(j,i)
462 CALL local_index(il,ig,nsv,nsn)
463 irect(j,i)=il
464 ENDDO
465 ENDDO
466C
467 RETURN
468 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:45
inelts
subroutine inelts(x, irect, ixs, nint, nel, i, area, noint, ir, surf_eltyp, surf_elem)
Definition inelt.F:39
ineltc
subroutine ineltc(nelc, neltg, is, surf_eltyp, surf_elem)
Definition inelt.F:132
insol3
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
Definition insol3.F:43
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:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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:889
starter
program starter
Definition starter.F:39
volint
subroutine volint(vol)
Definition volint.F:38