OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21gap3.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/.
23!||====================================================================
24!|| i21gap3 ../starter/source/interfaces/inter3d1/i21gap3.F
25!||--- called by ------------------------------------------------------
26!|| inint3_thkvar ../starter/source/interfaces/inter3d1/inint3_thkvar.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| i4gmx3 ../starter/source/interfaces/inter3d1/i4gmx3.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.f
32!||====================================================================
33 SUBROUTINE i21gap3(
34 1 X ,IRECTS ,IRECTM ,NRTS ,NRTM ,
35 2 GEO ,PM ,IXS ,IXC ,IXTG ,
36 3 NINT ,NTY ,NOINT ,NSN ,NSV ,
37 4 GAP ,IGAP ,GAP_S ,GAPMIN,CRITER,
38 5 GAPMAX,IELES ,STF ,NMN ,MSR ,
39 6 KNOD2ELS ,KNOD2ELC ,KNOD2ELTG ,NOD2ELS ,NOD2ELC,
40 7 NOD2ELTG ,THKNOD ,
41 8 IKINE ,ITAB ,INACTI ,GAPSCALE,STFN ,
42 9 DEPTH ,GAP_S0 ,AREA_S0 ,XM0 ,LXM ,
43 A LYM ,LZM ,INTTH ,DRAD ,IPARTS ,
44 B IPARTC ,IPARTG ,THK_PART ,THKNOD0 ,ID ,
45 C TITR ,DGAPLOAD ,RESORT )
46 USE message_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60#include "param_c.inc"
61#include "units_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER NRTS, NRTM, NINT, NTY, NOINT,NSN, NMN, IGAP,
66 . INACTI, INTTH
67 INTEGER IRECTS(4,*), IRECTM(4,*), IXS(NIXS,*), IXC(NIXC,*),
68 . NSV(*), IXTG(NIXTG,*),
69 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
70 . NOD2ELTG(*),IELES(*),
71 . MSR(*), ITAB(*), IKINE(*), IPARTS(*), IPARTC(*), IPARTG(*)
72 INTEGER , INTENT (IN) :: RESORT
73C REAL
74 my_real , INTENT(IN) :: DGAPLOAD
75 my_real
76 . GAP,GAPMIN,CRITER, GAPMAX, GAPSCALE, DEPTH, DRAD, LXM, LYM, LZM
77 my_real
78 . x(3,*), pm(npropm,*), geo(npropg,*),
79 . gap_s(*), thknod(*), stf(*), stfn(*),
80 . gap_s0(*), area_s0(*), xm0(3,*),thk_part(*),thknod0(*)
81 INTEGER ID
82 CHARACTER(LEN=NCHARTITLE) :: TITR
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER NDX, I, J, II, INRT, NELS, NELC, NELTG, NEL,
87 . n1,n2,n3,n4, ix, n, l, llt, nn, ip, stat
88 INTEGER ITMP(NUMNOD)
89C REAL
90 my_real
91 . dxm, gapmx, gapmn, area, dx,gaps1,gaps2, gapm, ddx,
92 . gaptmp, xxx, yyy, zzz, x0, x1, y0, y1, z0, z1
93 my_real
94 . x12(mvsiz),y12(mvsiz),z12(mvsiz),
95 . x13(mvsiz),y13(mvsiz),z13(mvsiz),
96 . x24(mvsiz),y24(mvsiz),z24(mvsiz),
97 . nx(mvsiz),ny(mvsiz),nz(mvsiz),aa(mvsiz)
98 my_real, DIMENSION(:), ALLOCATABLE :: thk_part_nods
99C--------------------------------------------------------------
100 dxm=zero
101 ndx = 0
102 gapmx=ep30
103 gapmn=ep30
104 gaps1=zero
105 gaps2=zero
106C------------------------------------
107C GAP FACES SECONDS
108C------------------------------------
109 DO 250 i=1,nrts
110 gapm =zero
111 inrt=i
112 CALL i4gmx3(x,irects,inrt,gapmx)
113 250 CONTINUE
114C-------------------------------------------------------
115C THICKNESS PART ON SECND NODES FOR GAP CALCULATION
116C-------------------------------------------------------
117 IF(igap>=1)THEN
118 ALLOCATE (thk_part_nods(numnod) ,stat=stat)
119 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
120 . msgtype=msgerror,
121 . c1='THK_PART_NODS')
122 thk_part_nods(1:numnod) = zero
123 DO i=1,nrts
124 nel = ieles(i)
125 IF(nel<=numels) THEN ! SOLID ELEMENT
126 ip = iparts(nel)
127 DO n =1,4
128 nn = irects(n,i)
129 thk_part_nods(nn) = max(thk_part_nods(n),thk_part(ip))
130 ENDDO
131 ELSEIF(nel<=(numels+numelc)) THEN ! SHELL ELEMENT
132 ip = ipartc(nel-numels)
133 DO n =1,4
134 nn = irects(n,i)
135 thk_part_nods(nn) = max(thk_part_nods(n),thk_part(ip))
136 ENDDO
137 ELSE ! SHELL 3 ELEMENT
138 ip = ipartg(nel-numels-numelc)
139 DO n =1,4
140 nn = irects(n,i)
141 thk_part_nods(nn) = max(thk_part_nods(n),thk_part(ip))
142 ENDDO
143 ENDIF
144 ENDDO
145 ENDIF
146
147C------------------------------------
148C GAP VARIABLE NOEUDS SECONDS
149C------------------------------------
150 IF(igap>=1)THEN
151 DO i=1,nsn
152 IF(thk_part_nods(nsv(i))/=zero) THEN ! IF a contact thickness is defined
153 dx = thk_part_nods(nsv(i))*gapscale
154 ELSE
155 dx = thknod(nsv(i))*gapscale
156 ENDIF
157 gapm = half*dx
158
159 gaps2 = max(gaps2,gapm)
160 gap_s(i)= gapm
161C =====
162C Gapmin >= t average of nodal thicknesses
163C =====
164 dxm=dxm+dx
165 ndx=ndx+1
166
167 thknod0(i) = thknod(nsv(i)) ! Initial THICK NODE STORED
168 ENDDO
169 IF (ALLOCATED(thk_part_nods)) DEALLOCATE(thk_part_nods)
170 ENDIF
171
172C------------------------------------
173C GAP
174C------------------------------------
175 gapmx=sqrt(gapmx)
176 IF(igap==0)THEN
177C GAP FIXE
178 IF(gap<=zero)THEN
179 DO i=1,nsn
180 dx = thknod(nsv(i))
181C =====
182C Gap = t average of nodal thicknesses
183C =====
184 dxm=dxm+dx
185 ndx=ndx+1
186 ENDDO
187 gap = half*dxm/ndx
188 IF (resort==0) WRITE(iout,1000)gap
189 ENDIF
190 gapmin = gap
191 gapmax = gap
192 ELSE
193C SUP DES GAPS VARIABLES
194 IF(gap>zero)gapmin=gap
195 IF (resort==0) WRITE(iout,1000)gapmin
196C
197C GAP n'est pas utilise pour Igap > 0 ; Gapmin peut etre egal a 0.
198 IF(gapmax==zero)gapmax=ep30
199 IF (resort==0) WRITE(iout,1500)gapmax
200 gap = min(gap,gapmax)
201 ENDIF
202C---------------------------------------------
203C---------------------------------------------
204C SUP DES GAPS VARIABLES
205 gap = min(gapmax,max(gaps2,gapmin))
206C---------------------------------------------
207C
208C Calcul du gap reel a utiliser lors du critere de retri
209C
210 IF (igap==0) THEN
211 criter=gap
212 ELSE
213 criter=ep30
214 DO i = 1, nsn
215 criter = min(criter,gap_s(i))
216 ENDDO
217 criter=max(criter,gapmin)
218 ENDIF
219C
220 IF(dgapload > zero) criter=max(criter,em01*(gap + dgapload))
221C
222 IF(depth==zero)THEN
223C Valeur par defaut de Depth = max( sup des gaps , largeur des elts )
224 depth=max(gap,gapmx)
225C cest encore necessaire au tri dans le starter
226 ELSEIF(depth<gap)THEN
227C Depth est tjrs superieur au gap (sup des gaps si variable)
228 depth=gap
229 END IF
230 IF (resort==0) WRITE(iout,2000)depth
231C
232 criter=max(criter,em01*depth)
233C
234 IF(depth>gapmx .AND. resort==0 )THEN
235 CALL ancmsg(msgid=687,
236 . msgtype=msgwarning,
237 . anmode=aninfo_blind_2,
238 . i1=id,
239 . c1=titr,
240 . r1=depth,
241 . r2=gapmx,
242 . i2=id)
243 ENDIF
244C
245 IF(intth/=0)THEN
246 IF(drad==zero)THEN
247 drad=max(gap,gapmx)
248 ELSEIF(drad<gap)THEN
249 drad=gap
250 END IF
251 IF (resort==0) WRITE(iout,2001)drad
252C
253 criter=max(criter,em01*drad)
254C
255 IF(drad>gapmx .AND. resort==0)THEN
256 CALL ancmsg(msgid=918,
257 . msgtype=msgwarning,
258 . anmode=aninfo_blind_2,
259 . i1=id,
260 . c1=titr,
261 . r1=drad ,
262 . r2=gapmx,
263 . i2=id)
264 END IF
265 END IF
266C------------------------------------
267C STiff cote main (1: active ; 0: inactive)
268C------------------------------------
269 DO i=1,nrtm
270 stf(i)=one
271 END DO
272C---------------------------------------------
273C MISE A ONE DU MULTIPLICATEUR NODALE DES RIGIDITES
274C---------------------------------------------
275 DO i=1,nsn
276 stfn(i) = one
277 END DO
278C------------------------------------
279 IF(igap==2)THEN
280 DO i=1,nsn
281 gap_s0(i) = min(gap_s(i),gapmax)
282 gap_s0(i) = max(gapmin ,gap_s0(i))
283 END DO
284
285 IF(intth == 0) THEN
286 itmp=0
287 DO i=1,nsn
288 ii=nsv(i)
289 itmp(ii)=i
290 END DO
291 DO n=1,nrts,mvsiz
292C
293 llt=min(nrts-n+1,mvsiz)
294C
295 DO l=1,llt
296 i=n+l-1
297C
298 n1=irects(1,i)
299 n2=irects(2,i)
300 n3=irects(3,i)
301 n4=irects(4,i)
302 IF(n4/=n3)THEN
303 x13(l)=x(1,n3)-x(1,n1)
304 y13(l)=x(2,n3)-x(2,n1)
305 z13(l)=x(3,n3)-x(3,n1)
306 x24(l)=x(1,n4)-x(1,n2)
307 y24(l)=x(2,n4)-x(2,n2)
308 z24(l)=x(3,n4)-x(3,n2)
309 nx(l)=y13(l)*z24(l)-z13(l)*y24(l)
310 ny(l)=z13(l)*x24(l)-x13(l)*z24(l)
311 nz(l)=x13(l)*y24(l)-y13(l)*x24(l)
312 aa(l)=one_over_8*sqrt(nx(l)*nx(l)+ny(l)*ny(l)+nz(l)*nz(l))
313 area_s0(itmp(n1))=area_s0(itmp(n1))+aa(l)
314 area_s0(itmp(n2))=area_s0(itmp(n2))+aa(l)
315 area_s0(itmp(n3))=area_s0(itmp(n3))+aa(l)
316 area_s0(itmp(n4))=area_s0(itmp(n4))+aa(l)
317 ELSE
318 x12(l)=x(1,n2)-x(1,n1)
319 y12(l)=x(2,n2)-x(2,n1)
320 z12(l)=x(3,n2)-x(3,n1)
321 x13(l)=x(1,n3)-x(1,n1)
322 y13(l)=x(2,n3)-x(2,n1)
323 z13(l)=x(3,n3)-x(3,n1)
324 nx(l)=y12(l)*z13(l)-z12(l)*y13(l)
325 ny(l)=z12(l)*x13(l)-x12(l)*z13(l)
326 nz(l)=x12(l)*y13(l)-y12(l)*x13(l)
327 aa(l)=one_over_6*sqrt(nx(l)*nx(l)+ny(l)*ny(l)+nz(l)*nz(l))
328 area_s0(itmp(n1))=area_s0(itmp(n1))+aa(l)
329 area_s0(itmp(n2))=area_s0(itmp(n2))+aa(l)
330 area_s0(itmp(n3))=area_s0(itmp(n3))+aa(l)
331 END IF
332 END DO
333 END DO
334 igap = 1
335 ENDIF
336 ELSE
337 IF(intth==0) THEN
338 itmp=0
339 DO i=1,nsn
340 ii=nsv(i)
341 itmp(ii)=i
342 END DO
343 DO n=1,nrts,mvsiz
344C
345 llt=min(nrts-n+1,mvsiz)
346C
347 DO l=1,llt
348 i=n+l-1
349C
350 n1=irects(1,i)
351 n2=irects(2,i)
352 n3=irects(3,i)
353 n4=irects(4,i)
354 IF(n4/=n3)THEN
355 x13(l)=x(1,n3)-x(1,n1)
356 y13(l)=x(2,n3)-x(2,n1)
357 z13(l)=x(3,n3)-x(3,n1)
358 x24(l)=x(1,n4)-x(1,n2)
359 y24(l)=x(2,n4)-x(2,n2)
360 z24(l)=x(3,n4)-x(3,n2)
361 nx(l)=y13(l)*z24(l)-z13(l)*y24(l)
362 ny(l)=z13(l)*x24(l)-x13(l)*z24(l)
363 nz(l)=x13(l)*y24(l)-y13(l)*x24(l)
364 aa(l)=one_over_8*sqrt(nx(l)*nx(l)+ny(l)*ny(l)+nz(l)*nz(l))
365 area_s0(itmp(n1))=area_s0(itmp(n1))+aa(l)
366 area_s0(itmp(n2))=area_s0(itmp(n2))+aa(l)
367 area_s0(itmp(n3))=area_s0(itmp(n3))+aa(l)
368 area_s0(itmp(n4))=area_s0(itmp(n4))+aa(l)
369 ELSE
370 x12(l)=x(1,n2)-x(1,n1)
371 y12(l)=x(2,n2)-x(2,n1)
372 z12(l)=x(3,n2)-x(3,n1)
373 x13(l)=x(1,n3)-x(1,n1)
374 y13(l)=x(2,n3)-x(2,n1)
375 z13(l)=x(3,n3)-x(3,n1)
376 nx(l)=y12(l)*z13(l)-z12(l)*y13(l)
377 ny(l)=z12(l)*x13(l)-x12(l)*z13(l)
378 nz(l)=x12(l)*y13(l)-y12(l)*x13(l)
379 aa(l)=one_over_6*sqrt(nx(l)*nx(l)+ny(l)*ny(l)+nz(l)*nz(l))
380 area_s0(itmp(n1))=area_s0(itmp(n1))+aa(l)
381 area_s0(itmp(n2))=area_s0(itmp(n2))+aa(l)
382 area_s0(itmp(n3))=area_s0(itmp(n3))+aa(l)
383 END IF
384 END DO
385 END DO
386 ENDIF
387 ENDIF
388C------------------------------------
389 lxm=zero
390 lym=zero
391 lzm=zero
392 DO i=1,nrtm
393 x0=ep30
394 x1=-ep30
395 y0=ep30
396 y1=-ep30
397 z0=ep30
398 z1=-ep30
399 DO j=1,4
400 ix=msr(irectm(j,i))
401 xxx=x(1,ix)
402 yyy=x(2,ix)
403 zzz=x(3,ix)
404 x0=min(x0,xxx)
405 y0=min(y0,yyy)
406 z0=min(z0,zzz)
407 x1=max(x1,xxx)
408 y1=max(y1,yyy)
409 z1=max(z1,zzz)
410 END DO
411 lxm=max(lxm,x1-x0)
412 lym=max(lym,y1-y0)
413 lzm=max(lzm,z1-z0)
414 ENDDO
415C------------------------------------
416 RETURN
417 1000 FORMAT(2x,'GAP MIN = ',1pg20.13)
418 1500 FORMAT(2x,'GAP MAX = ',1pg20.13)
419 2000 FORMAT(2x,'DEPTH BEFORE RELEASE = ',1pg20.13)
420 2001 FORMAT(2x,'Maximum distance for radiation computation = ',
421 . 1pg20.13)
422 END
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i4gmx3
subroutine i4gmx3(x, irect, i, gapmax)
Definition i4gmx3.F:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
i21gap3
subroutine i21gap3(x, irects, irectm, nrts, nrtm, geo, pm, ixs, ixc, ixtg, nint, nty, noint, nsn, nsv, gap, igap, gap_s, gapmin, criter, gapmax, ieles, stf, nmn, msr, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thknod, ikine, itab, inacti, gapscale, stfn, depth, gap_s0, area_s0, xm0, lxm, lym, lzm, intth, drad, iparts, ipartc, ipartg, thk_part, thknod0, id, titr, dgapload, resort)
Definition i21gap3.F:46
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