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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i21gap3()

subroutine i21gap3 ( x,
integer, dimension(4,*) irects,
integer, dimension(4,*) irectm,
integer nrts,
integer nrtm,
geo,
pm,
integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer nint,
integer nty,
integer noint,
integer nsn,
integer, dimension(*) nsv,
gap,
integer igap,
gap_s,
gapmin,
criter,
gapmax,
integer, dimension(*) ieles,
stf,
integer nmn,
integer, dimension(*) msr,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
thknod,
integer, dimension(*) ikine,
integer, dimension(*) itab,
integer inacti,
gapscale,
stfn,
depth,
gap_s0,
area_s0,
xm0,
lxm,
lym,
lzm,
integer intth,
drad,
integer, dimension(*) iparts,
integer, dimension(*) ipartc,
integer, dimension(*) ipartg,
thk_part,
thknod0,
integer id,
character(len=nchartitle) titr,
intent(in) dgapload,
integer, intent(in) resort )

Definition at line 33 of file i21gap3.F.

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)
my_real
#define my_real
Definition cppsort.cpp:32
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
id
initmumps id
Definition multiplerhs_example.m:4
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