OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24buc1.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "vect07_c.inc"
#include "scr06_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i24buc1 (x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, cand_e, cand_n, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, stf, stfn, multimp, istf, iddlevel, itab, gap_s, gap_m, igap, gapmin, gapmax, inacti, gap_s_l, gap_m_l, i_mem, marge, id, titr, nbinflg, mbinflg, ilev, msegtyp, gap_n, mvoisn, ixs, ixs10, ixs16, ixs20, ipartns, ipen0, penmax, irtse, is2se, is2pt, xfic, nrtse, nsne, prov_n, prov_e, nsvg, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, n11, n21, n31, dgapload, s_kremnode, s_remnode, kremnode, remnode, flag_removed_node)
subroutine i24s1s2 (prov_n, prov_e, nbinflg, mbinflg, pene)

Function/Subroutine Documentation

◆ i24buc1()

subroutine i24buc1 ( x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
bumult,
integer, dimension(*) nseg,
integer nmn,
integer nrtm,
integer, dimension(*) mwa,
integer nsn,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
gap,
xyzm,
integer noint,
integer i_stok,
dist,
tzinf,
maxbox,
minbox,
integer, dimension(*) msr,
stf,
stfn,
integer multimp,
integer istf,
integer iddlevel,
integer, dimension(*) itab,
gap_s,
gap_m,
integer igap,
gapmin,
gapmax,
integer inacti,
gap_s_l,
gap_m_l,
integer i_mem,
marge,
integer id,
character(len=nchartitle) titr,
integer, dimension(*) nbinflg,
integer, dimension(*) mbinflg,
integer ilev,
integer, dimension(*) msegtyp,
gap_n,
integer, dimension(4,*) mvoisn,
integer, dimension(*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) ipartns,
integer ipen0,
penmax,
integer, dimension(*) irtse,
integer, dimension(*) is2se,
integer, dimension(*) is2pt,
xfic,
integer nrtse,
integer nsne,
integer, dimension(mvsiz), intent(inout) prov_n,
integer, dimension(mvsiz), intent(inout) prov_e,
integer, dimension(mvsiz), intent(inout) nsvg,
integer, dimension(mvsiz), intent(inout) ix1,
integer, dimension(mvsiz), intent(inout) ix2,
integer, dimension(mvsiz), intent(inout) ix3,
integer, dimension(mvsiz), intent(inout) ix4,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(inout) xi,
intent(inout) yi,
intent(inout) zi,
intent(inout) x0,
intent(inout) y0,
intent(inout) z0,
intent(inout) stif,
intent(in) pene,
intent(inout) nx1,
intent(inout) ny1,
intent(inout) nz1,
intent(inout) nx2,
intent(inout) ny2,
intent(inout) nz2,
intent(inout) nx3,
intent(inout) ny3,
intent(inout) nz3,
intent(inout) nx4,
intent(inout) ny4,
intent(inout) nz4,
intent(inout) p1,
intent(inout) p2,
intent(inout) p3,
intent(inout) p4,
intent(inout) lb1,
intent(inout) lb2,
intent(inout) lb3,
intent(inout) lb4,
intent(inout) lc1,
intent(inout) lc2,
intent(inout) lc3,
intent(inout) lc4,
intent(in) n11,
intent(in) n21,
intent(in) n31,
intent(in) dgapload,
integer, intent(in) s_kremnode,
integer, intent(in) s_remnode,
integer, dimension(s_kremnode), intent(in) kremnode,
integer, dimension(s_remnode), intent(in) remnode,
logical, intent(in) flag_removed_node )
Parameters
[in]flag_removed_nodeflag to remove some S node from the list of candidates
[in]s_kremnodesize of KREMNODE
[in]s_remnodesize of REMNODE

Definition at line 39 of file i24buc1.F.

64C-----------------------------------------------
65C M o d u l e s
66C-----------------------------------------------
67#ifndef HYPERMESH_LIB
68 USE message_mod
69#endif
70 USE names_and_titles_mod , ONLY : nchartitle
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C G l o b a l P a r a m e t e r s
77C-----------------------------------------------
78#include "mvsiz_p.inc"
79C-----------------------------------------------
80C C o m m o n B l o c k s
81C-----------------------------------------------
82#include "units_c.inc"
83#include "com04_c.inc"
84#include "vect07_c.inc"
85#include "scr06_c.inc"
86C-----------------------------------------------
87C D u m m y A r g u m e n t s
88C-----------------------------------------------
89 INTEGER NMN, NRTM, NSN, NOINT,I_STOK,MULTIMP,ISTF,IGAP,
90 . INACTI,MVOISN(4,*),IPARTNS(*),IPEN0,IRTSE(*),
91 . IS2SE(*) ,IS2PT(*),NRTSE ,NSNE
92 INTEGER IRECT(4,*),NSV(*),NSEG(*),MWA(*)
93 INTEGER CAND_E(*),CAND_N(*),MSR(*),MAXSIZ,IDDLEVEL
94 INTEGER ITAB(*),NBINFLG(*),MBINFLG(*),ILEV,MSEGTYP(*)
95 INTEGER IXS(*), IXS10(6,*), IXS16(8,*), IXS20(12,*)
96C REAL
97 my_real , INTENT(IN) :: dgapload
98 my_real
99 . stf(*),stfn(*),x(3,*),xyzm(6,*),gap_s(*),gap_m(*),
100 . dist,bumult,gap,tzinf,maxbox,minbox,gapmin,gapmax,
101 . gap_s_l(*),gap_m_l(*),marge,gap_n(12,*),penmax,xfic(3,*)
102 INTEGER ID
103 LOGICAL, INTENT(in) :: FLAG_REMOVED_NODE !< flag to remove some S node from the list of candidates
104 INTEGER, INTENT(in) :: S_KREMNODE !< size of KREMNODE
105 INTEGER, INTENT(in) :: S_REMNODE !< size of REMNODE
106 INTEGER, DIMENSION(S_KREMNODE), INTENT(in) :: KREMNODE
107 INTEGER, DIMENSION(S_REMNODE), INTENT(in) :: REMNODE
108 CHARACTER(LEN=NCHARTITLE) :: TITR
109 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) ::PROV_N,PROV_E
110 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
111 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
112 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
113 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
114 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi,stif
115 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
116 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n11,n21,n31,pene
117 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
118 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
119 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
120 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
121 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
122 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lb1,lb2,lb3,lb4
123 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lc1,lc2,lc3,lc4
124C-----------------------------------------------
125C L o c a l V a r i a b l e s
126C-----------------------------------------------
127 INTEGER I, J, L, N1, N2, N3, N4, I_AMAX,I_MEM,N_SOL
128 INTEGER I_ADD, ADESTK, NB_NC, NB_EC, ADNSTK, IBID
129 INTEGER IP1, IP2, IP21, IP22, IP31,J_STOK,I_BID,NB_N_B,
130 + NPT_E,NSN0,LWORK,NUMNODT
131C REAL
132 my_real
133 . dx1,dy1,dz1,
134 . dx3,dy3,dz3,
135 . dx4,dy4,dz4,
136 . dx6,dy6,dz6,
137 . dd1,dd2,dd3,dd4,dd,dd0,xmin,ymin,zmin,
138 . xmax,ymax,zmax,tzinf0,minbox0,maxbox0,gapsmax,
139 . bid,tzinf_st,marge_st,gapv(mvsiz),dd_st,d_max,pensol,d_moy
140 INTEGER ,
141 . DIMENSION(:),ALLOCATABLE :: IWORK
142 my_real,
143 . DIMENSION(:,:),ALLOCATABLE :: xten
144 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_REMOVED_NODE
145C
146 ALLOCATE( tag_removed_node(numnod) )
147 tag_removed_node(1:numnod) = 0
148 gapmax=ep30
149 gapmin=zero
150C----edge fictive nodes-----
151 nsn0 = nsn - nsne
152 IF (nsne >0) THEN
153 numnodt =numnod+nsne
154 ALLOCATE(xten(3,numnodt))
155 xten=zero
156 xten(1:3,1:numnod) = x(1:3,1:numnod)
157 npt_e = 3
158 CALL i24xfic_ini(nrtse ,irtse ,nsne ,is2se ,is2pt ,
159 + nsn ,nsv ,x ,xfic ,npt_e )
160 xten(1:3,numnod+1:numnodt) = xfic(1:3,1:nsne)
161 maxsiz = max(numnodt,nrtm+100)
162 ip1 = 1
163 ip2 = ip1+maxsiz
164C IP21= IP2+2*MAXSIZ
165 ip21= ip2+3*maxsiz
166 ip22= ip21+numnodt
167 ip31= ip22+numnodt
168C------don't use no more MWA which is not sufficient; I_ADD<=1000
169 lwork = ip31 + 2000
170 ALLOCATE(iwork(lwork))
171 END IF
172C-------use temporarily GAP_N(1,*)=V/A; MVOISN(1,*)-> MTYPE(solid),MVOISN(2,*)-> E_id
173C
174C
175C 1-CALCUL TAILLE DES ZONES INFLUENCES
176C DD EST LA LONGEUR MOYENNE ELEMENT
177C DD_ST EST LA LONGEUR MAX ELEMENT
178 dd=zero
179 dd_st=zero
180 pensol=ep30
181 d_moy = zero
182 n_sol = 0
183 DO 10 l=1,nrtm
184C CONNECIVITES ELEMENT
185 n1=irect(1,l)
186 n2=irect(2,l)
187 n3=irect(3,l)
188 n4=irect(4,l)
189C LONGUEUR COTE 1
190 dx1=(x(1,n1)-x(1,n2))
191 dy1=(x(2,n1)-x(2,n2))
192 dz1=(x(3,n1)-x(3,n2))
193 dd1=sqrt(dx1**2+dy1**2+dz1**2)
194C LONGUEUR COTE 2
195 dx3=(x(1,n1)-x(1,n4))
196 dy3=(x(2,n1)-x(2,n4))
197 dz3=(x(3,n1)-x(3,n4))
198 dd2=sqrt(dx3**2+dy3**2+dz3**2)
199C LONGUEUR COTE 3
200 dx4=(x(1,n3)-x(1,n2))
201 dy4=(x(2,n3)-x(2,n2))
202 dz4=(x(3,n3)-x(3,n2))
203 dd3=sqrt(dx4**2+dy4**2+dz4**2)
204C LONGUEUR COTE 4
205 dx6=(x(1,n4)-x(1,n3))
206 dy6=(x(2,n4)-x(2,n3))
207 dz6=(x(3,n4)-x(3,n3))
208 dd4=sqrt(dx6**2+dy6**2+dz6**2)
209 dd=dd+ (dd1+dd2+dd3+dd4)
210C-------only for solid--- and coating shell
211 IF (msegtyp(l)==0.OR.msegtyp(l)>nrtm) THEN
212 d_max=max(dd1,dd2,dd3,dd4)
213 d_max=min(d_max,gap_n(1,l))
214C--------correction of too huge GAP_N(1,L) w/ irregular mesh
215 gap_n(1,l)=d_max
216 dd_st=max(dd_st,d_max)
217 n_sol = n_sol + 1
218 d_moy = d_moy + d_max
219 END IF
220C IF (MSEGTYP(L)==0) DD_ST=MAX(DD_ST,DD1,DD2,DD3,DD4)
221 10 CONTINUE
222C TAILLE ZINF = .1*TAILLE MOYENNE ELEMENT DE CHAQUE COTE
223C TAILLE BUCKET MIN = TZINF * BUMULT
224C DD = DD/NRTM/4
225 dd0=dd/nrtm/four
226 dd=dd0
227C DD = MAX(DD0,ONEP251*GAP)
228C TZINF = BUMULT*DD
229 marge = bumult*dd
230C calcul de TZINF en fct de la marge et non le contraire
231 tzinf = marge + gap + dgapload
232C MARGE_ST : marge independante du BUMULT en input pour trouver les memes pene initiales (cas delete ou chgt coord.)
233 marge_st = bmul0*dd
234C--------suppose PEN_ini< DD_ST/2 (half thickness of solids )
235 IF (inacti /=0 ) THEN
236C-------input PENMAX will fix the PENMAX value-----
237 IF (penmax /= zero) THEN
238 marge_st = max(marge_st,penmax)
239#ifndef HYPERMESH_LIB
240 IF (iddlevel == 1 ) WRITE(iout,2400) penmax
241#endif
242 ELSE
243 IF (n_sol>0) THEN
244 d_moy = d_moy/n_sol
245 dd_st = d_moy
246 END IF
247 pensol = min(half*dd_st,pensol)
248 marge_st = max(marge_st,pensol)
249C--------should also think about shells----
250 pensol = max(pensol,half*gap)
251 penmax = pensol
252#ifndef HYPERMESH_LIB
253 IF (iddlevel == 1 ) WRITE(iout,2500) penmax
254#endif
255 END if!(PENMAX/=ZERO)
256 ELSE
257C-----il faut pas eliminer tiny penetration----
258 penmax = max(pensol,gap)
259 END IF
260C 1er passage avec marge x2 pour trouver plus de candidats
261 IF(iddlevel==0) marge_st = marge
262 tzinf_st = marge_st + gap + dgapload
263 bid = four_over_5*dd
264 IF (inacti/=7.AND.tzinf>bid) THEN
265 ibid = nint(tzinf/dd0)
266 ibid =(2*ibid+4)*ibid*2
267 ENDIF
268C MAXBOX= ZEP9*(DD - TZINF)
269C DD + 2*TZINF : taille element augmentee de zone influence
270 maxbox= half*(dd + 2*tzinf)
271 minbox= half*maxbox
272 tzinf0 = tzinf
273 minbox0 = minbox
274 maxbox0 = maxbox
275C MIS A ZERO POUR FAIRE SEARCH COMPLET CYCLE 0 ENGINE
276 dist = zero
277C--------------------------------
278C CALCUL DES BORNES DU DOMAINE
279C--------------------------------
280 xmin=ep30
281 xmax=-ep30
282 ymin=ep30
283 ymax=-ep30
284 zmin=ep30
285 zmax=-ep30
286C
287 DO 20 i=1,nmn
288 j=msr(i)
289 xmin= min(xmin,x(1,j))
290 ymin= min(ymin,x(2,j))
291 zmin= min(zmin,x(3,j))
292 xmax= max(xmax,x(1,j))
293 ymax= max(ymax,x(2,j))
294 zmax= max(zmax,x(3,j))
295 20 CONTINUE
296 xmin=xmin-tzinf_st
297 ymin=ymin-tzinf_st
298 zmin=zmin-tzinf_st
299 xmax=xmax+tzinf_st
300 ymax=ymax+tzinf_st
301 zmax=zmax+tzinf_st
302 DO 25 i=1,nsn0
303 j=nsv(i)
304 xmin= min(xmin,x(1,j))
305 ymin= min(ymin,x(2,j))
306 zmin= min(zmin,x(3,j))
307 xmax= max(xmax,x(1,j))
308 ymax= max(ymax,x(2,j))
309 zmax= max(zmax,x(3,j))
310 25 CONTINUE
311C
312C
313C-----2- TRI PAR BOITES DES ELEMENTS ET DES NOEUDS
314C
315 nb_n_b = 1
316 i_mem = 0
317C SI ON A PAS ASSEZ DE MEMOIRE POUR LES PILES ON RECOMMENCE LE TRI
318C EN INCREMENTANT LE NB_N_B (NOMBRE DE NOEUDS PAR BOITE FINIE)
319 100 CONTINUE
320C POINTEUR NOM TAILLE
321C P1........Elt Bas Pile NRTM
322C P2........Elt PILE 2*NRTM
323C P21.......BPN NSN
324C P22.......PN NSN
325C P31.......ADDI 2000
326C
327C POUR ONE MAILLAGE DE TOPOLOGIE CARRE LA TAILLE DE P2 PEUT ETRE ESTIMEE A:
328C 4n: NUMELC + 6*SQRT(NUMELC) + 8*LOG2(NUMELC)
329C 3n: NUMELTG + 6*SQRT(2*NUMELTG) + 8*LOG2(NUMELTG)
330C
331C 4n: NUMELC + 6*SQRT(NUMELC) + 12*LOG(NUMELC) +
332C 3n: NUMELTG + 6*SQRT(2*NUMELTG) + 12*LOG(NUMELTG)
333C
334C NUMELC + NUMELTG + 6*SQRT(NUMELC+2*NUMELTG) + 12*LOG(NUMELC+NUMELTG)
335C
336C POUR ONE MAILLAGE DE TOPOLOGIE LINEAIRE LA TAILLE DE P2 PEUT ETRE ESTIMEE A:
337C NUMELC + NUMELTG + (NUMELC+NUMELTG)*(1 + 1/2 + 1/4 +...) + LOG2(NUMELC+NUMELTG)
338C 3*(NUMELC+NUMELTG) + LOG2(NUMELC+NUMELTG)
339C 3*(NUMELC+NUMELTG) + 300
340C
341C IFIN= IP22+2000
342C
343C-----INITIALISATION DES ADRESSES ET X,Y,Z
344C
345C ADDE ADDN X Y Z
346C 1 1 XMIN YMIN ZMIN
347C 1 1 XMAX YMAX ZMAX
348C
349 IF (nsne >0) THEN
350 iwork(ip31) = 0
351 iwork(ip31+1) = 0
352 iwork(ip31+2) = 0
353 iwork(ip31+3) = 0
354 i_add = 1
355 i_amax = 1
356 xyzm(1,i_add) = xmin
357 xyzm(2,i_add) = ymin
358 xyzm(3,i_add) = zmin
359 xyzm(4,i_add) = xmax
360 xyzm(5,i_add) = ymax
361 xyzm(6,i_add) = zmax
362 i_stok = 0
363 j_stok = 0
364 adnstk = 0
365 adestk = 0
366 nb_nc = nsn
367 nb_ec = nrtm
368 DO i=1,nb_ec
369 iwork(ip1+i-1) = i
370 END DO
371 DO i=1,nb_nc
372 iwork(ip21+i-1) = i
373 END DO
374C
375 ELSE
376 maxsiz = max(numnod,nrtm+100)
377 ip1 = 1
378 ip2 = ip1+maxsiz
379C IP21= IP2+2*MAXSIZ
380 ip21= ip2+3*maxsiz
381 ip22= ip21+numnod
382 ip31= ip22+numnod
383C IFIN= IP22+2000
384C
385C-----INITIALISATION DES ADRESSES ET X,Y,Z
386C
387C ADDE ADDN X Y Z
388C 1 1 XMIN YMIN ZMIN
389C 1 1 XMAX YMAX ZMAX
390C
391 mwa(ip31) = 0
392 mwa(ip31+1) = 0
393 mwa(ip31+2) = 0
394 mwa(ip31+3) = 0
395 i_add = 1
396 i_amax = 1
397 xyzm(1,i_add) = xmin
398 xyzm(2,i_add) = ymin
399 xyzm(3,i_add) = zmin
400 xyzm(4,i_add) = xmax
401 xyzm(5,i_add) = ymax
402 xyzm(6,i_add) = zmax
403 i_stok = 0
404 j_stok = 0
405 adnstk = 0
406 adestk = 0
407 nb_nc = nsn
408 nb_ec = nrtm
409C
410C-----COPIE DES NOS DE SEGMENTS ET DE NOEUDS DANS MWA(IP1) ET IP21
411C
412 DO 120 i=1,nb_ec
413 mwa(ip1+i-1) = i
414 120 CONTINUE
415 DO 140 i=1,nb_nc
416 mwa(ip21+i-1) = i
417 140 CONTINUE
418 END IF !(NSNE >0) THEN
419C-----DEBUT DE LA PHASE DE TRI
420C
421C TANT QUE IL RESTE UNE ADRESSE A TRIER
422C------------------
423 200 CONTINUE
424C------------------
425C SEPARER B ET N EN TWO
426 IF (nsne >0) THEN
427 CALL i24tri(
428 1 iwork(ip1),iwork(ip2),iwork(ip21),iwork(ip22),
429 + iwork(ip31+2*(i_add-2)),
430 2 irect ,xten ,nb_nc ,nb_ec ,xyzm ,
431 3 i_add ,nsv ,i_amax ,xmax ,ymax ,
432 4 zmax ,3*maxsiz,i_stok ,i_mem ,nb_n_b ,
433 5 cand_n ,cand_e ,nsn ,noint ,tzinf_st ,
434 6 maxbox ,minbox ,stf ,stfn ,j_stok ,
435 7 multimp ,istf , itab ,gap ,gap_s ,
436 8 gap_m ,igap ,gapmin ,gapmax ,marge_st ,
437 9 gap_s_l,gap_m_l ,id ,titr ,ilev ,
438 a nbinflg,mbinflg ,mvoisn ,ixs ,ixs10 ,
439 b ixs16 ,ixs20 ,ipartns ,ipen0 ,inacti ,
440 c msegtyp,marge ,nrtm ,irtse ,is2se ,
441 d ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
442 e x1 ,x2 ,x3 ,x4 ,y1 ,
443 f y2 ,y3 ,y4 ,z1 ,z2 ,
444 g z3 ,z4 ,xi ,yi ,zi ,
445 h x0 ,y0 ,z0 ,stif ,nx1 ,
446 i ny1 ,nz1 ,nx2 ,ny2 ,nz2 ,
447 j nx3 ,ny3 ,nz3 ,nx4 ,ny4 ,
448 k nz4 ,p1 ,p2 ,p3 ,p4 ,
449 l lb1 ,lb2 ,lb3 ,lb4 ,lc1 ,
450 m lc2 ,lc3 ,lc4 ,pene ,prov_n ,
451 n prov_e ,n11 ,n21 ,n31 ,dgapload,
452 o s_kremnode,s_remnode,kremnode,remnode,
453 p tag_removed_node,flag_removed_node)
454
455 ELSE
456 CALL i24tri(
457 1 mwa(ip1),mwa(ip2),mwa(ip21),mwa(ip22),mwa(ip31+2*(i_add-2)),
458 2 irect ,x ,nb_nc ,nb_ec ,xyzm ,
459 3 i_add ,nsv ,i_amax ,xmax ,ymax ,
460 4 zmax ,3*maxsiz,i_stok ,i_mem ,nb_n_b ,
461 5 cand_n ,cand_e ,nsn ,noint ,tzinf_st ,
462 6 maxbox ,minbox ,stf ,stfn ,j_stok ,
463 7 multimp ,istf , itab ,gap ,gap_s ,
464 8 gap_m ,igap ,gapmin ,gapmax ,marge_st ,
465 9 gap_s_l,gap_m_l ,id ,titr ,ilev ,
466 a nbinflg,mbinflg ,mvoisn ,ixs ,ixs10 ,
467 b ixs16 ,ixs20 ,ipartns ,ipen0 ,inacti ,
468 c msegtyp,marge ,nrtm ,irtse ,is2se ,
469 d ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
470 e x1 ,x2 ,x3 ,x4 ,y1 ,
471 f y2 ,y3 ,y4 ,z1 ,z2 ,
472 g z3 ,z4 ,xi ,yi ,zi ,
473 h x0 ,y0 ,z0 ,stif ,nx1 ,
474 i ny1 ,nz1 ,nx2 ,ny2 ,nz2 ,
475 j nx3 ,ny3 ,nz3 ,nx4 ,ny4 ,
476 k nz4 ,p1 ,p2 ,p3 ,p4 ,
477 l lb1 ,lb2 ,lb3 ,lb4 ,lc1 ,
478 m lc2 ,lc3 ,lc4 ,pene ,prov_n ,
479 n prov_e ,n11 ,n21 ,n31 ,dgapload,
480 o s_kremnode,s_remnode,kremnode,remnode,
481 p tag_removed_node,flag_removed_node)
482 END IF !(NSNE >0) THEN
483C------------------
484 IF (i_mem == 2)THEN
485 IF (nsne >0) DEALLOCATE(xten,iwork)
486 RETURN
487 ENDIF
488C I_MEM = 1 ==> PAS ASSEZ DE MEMOIRE PILE
489C I_MEM = 2 ==> PAS ASSEZ DE MEMOIRE CANDIDATS
490 IF(i_mem==1)THEN
491 nb_n_b = nb_n_b + 1
492 i_mem = 0
493 GO TO 100
494 ENDIF
495 IF(i_add/=0) GO TO 200
496C FIN BOUCLE TANT QUE
497C---------------------------------
498 IF(j_stok/=0)THEN
499 lft = 1
500 llt = j_stok
501 IF (nsne >0) THEN
502 CALL i7cor3(xten ,irect,nsv ,prov_e ,prov_n,
503 . stf ,stfn ,gapv ,igap ,gap ,
504 . gap_s,gap_m,istf ,gapmin ,gapmax,
505 . gap_s_l,gap_m_l ,zero ,ix1 ,ix2 ,
506 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
507 6 x3 ,x4 ,y1 ,y2 ,y3 ,
508 7 y4 ,z1 ,z2 ,z3 ,z4 ,
509 8 xi ,yi ,zi ,stif ,dgapload,
510 9 j_stok)
511 ELSE
512 CALL i7cor3(x ,irect,nsv ,prov_e ,prov_n,
513 . stf ,stfn ,gapv ,igap ,gap ,
514 . gap_s,gap_m,istf ,gapmin ,gapmax,
515 . gap_s_l,gap_m_l ,zero ,ix1 ,ix2 ,
516 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
517 6 x3 ,x4 ,y1 ,y2 ,y3 ,
518 7 y4 ,z1 ,z2 ,z3 ,z4 ,
519 8 xi ,yi ,zi ,stif ,dgapload,
520 9 j_stok)
521 END IF !(NSNE >0) THEN
522 CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
523 1 x4 ,y1 ,y2 ,y3 ,y4 ,
524 2 z1 ,z2 ,z3 ,z4 ,xi ,
525 3 yi ,zi ,x0 ,y0 ,z0 ,
526 4 nx1,ny1,nz1,nx2,ny2,
527 5 nz2,nx3,ny3,nz3,nx4,
528 6 ny4,nz4,p1 ,p2 ,p3 ,
529 7 p4 ,lb1,lb2,lb3,lb4,
530 8 lc1,lc2,lc3,lc4,j_stok)
531
532 CALL i7pen3(marge_st,gapv,n11,n21,n31,
533 1 pene ,nx1 ,ny1,nz1,nx2,
534 2 ny2 ,nz2 ,nx3,ny3,nz3,
535 3 nx4 ,ny4 ,nz4,p1 ,p2 ,
536 4 p3 ,p4,j_stok)
537
538 IF (ilev==2) CALL i24s1s2(prov_n,prov_e,nbinflg,mbinflg,pene)
539 IF(i_stok+j_stok<multimp*nsn) THEN
540 CALL i7cmp3(i_stok,cand_e ,cand_n,1,pene,
541 1 prov_n,prov_e)
542 ELSE
543 i_bid = 0
544 CALL i7cmp3(i_bid,cand_e,cand_n,0,pene,
545 1 prov_n,prov_e)
546 IF(i_stok+i_bid<multimp*nsn) THEN
547 CALL i7cmp3(i_stok,cand_e,cand_n,1,pene,
548 1 prov_n,prov_e)
549 ELSE
550 i_mem = 2
551 IF (nsne >0) DEALLOCATE(xten,iwork)
552 RETURN
553 ENDIF
554 ENDIF
555 ENDIF
556C
557
558#ifndef HYPERMESH_LIB
559 IF(nsn/=0)THEN
560 WRITE(iout,*)' POSSIBLE IMPACT NUMBER, NSN:',i_stok,nsn
561C
562 ELSE
563 CALL ancmsg(msgid=552,
564 . msgtype=msgwarning,
565 . anmode=aninfo_blind_2,
566 . i1=id,
567 . c1=titr)
568 ENDIF
569#endif
570
571C
572C MISE A ZERO DE TAG POUR I24PEN3
573C
574 DO i=1,numnod+nsne
575 mwa(i)=0
576 ENDDO
577
578#ifndef HYPERMESH_LIB
579 2400 FORMAT(2x,/,'user-defined(ipen_max)searching distance for initial penetrations ',
580 + 1PG20.13,'is used',/)
581 2500 FORMAT(2X,/,'computed searching distance for initial penetrations ',1PG20.13,
582 + 'is used',/)
583#endif
584
585C
586 IF (NSNE >0) DEALLOCATE(XTEN,IWORK)
587 DEALLOCATE( TAG_REMOVED_NODE )
588 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
i24s1s2
subroutine i24s1s2(prov_n, prov_e, nbinflg, mbinflg, pene)
Definition i24buc1.F:599
i24xfic_ini
subroutine i24xfic_ini(nrtse, irtse, nsne, is2se, is2pt, nsn, nsv, x, xfic, npt)
Definition i24surfi.F:1554
i24tri
subroutine i24tri(bpe, pe, bpn, pn, add, irect, x, nb_nc, nb_ec, xyzm, i_add, nsv, i_amax, xmax, ymax, zmax, maxsiz, i_stok, i_mem, nb_n_b, cand_n, cand_e, nsn, noint, tzinf, maxbox, minbox, stf, stfn, j_stok, multimp, istf, itab, gap, gap_s, gap_m, igap, gapmin, gapmax, marge, gap_s_l, gap_m_l, id, titr, ilev, nbinflg, mbinflg, mvoisn, ixs, ixs10, ixs16, ixs20, ipartns, ipen0, inacti, msegtyp, marge_sh, nrtm, irtse, is2se, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, pene, prov_n, prov_e, n11, n21, n31, dgapload, s_kremnode, s_remnode, kremnode, remnode, tag_removed_node, flag_removed_node)
Definition i24tri.F:65
i7cmp3
subroutine i7cmp3(i_stok, cand_e, cand_n, iflag, pene, prov_n, prov_e)
Definition i7cmp3.F:82
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
i7cor3
subroutine i7cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, gapmin, gapmax, gap_s_l, gap_m_l, drad, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, dgapload, last)
Definition i7cor3.F:43
i7dst3
subroutine i7dst3(ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, last)
Definition i7dst3.F:46
i7pen3
subroutine i7pen3(marge, gapv, n1, n2, n3, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, last)
Definition i7pen3.F:43
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

◆ i24s1s2()

subroutine i24s1s2 ( integer, dimension(*) prov_n,
integer, dimension(*) prov_e,
integer, dimension(*) nbinflg,
integer, dimension(*) mbinflg,
pene )

Definition at line 598 of file i24buc1.F.

599C-----------------------------------------------
600C I m p l i c i t T y p e s
601C-----------------------------------------------
602#include "implicit_f.inc"
603C-----------------------------------------------
604C G l o b a l P a r a m e t e r s
605C-----------------------------------------------
606#include "mvsiz_p.inc"
607C-----------------------------------------------
608C D u m m y A r g u m e n t s
609C-----------------------------------------------
610 INTEGER PROV_N(*),PROV_E(*),NBINFLG(*),MBINFLG(*)
611C REAL
612 my_real
613 . pene(mvsiz)
614C-----------------------------------------------
615C C o m m o n B l o c k s
616C-----------------------------------------------
617#include "vect07_c.inc"
618C-----------------------------------------------
619C L o c a l V a r i a b l e s
620C-----------------------------------------------
621 INTEGER I,N,NE,IMS1,IMS2,ISS1,ISS2
622C REAL
623C-----------------------------------------------
624C
625 INTEGER BITGET
626 EXTERNAL bitget
627C=======================================================================
628 DO i=lft,llt
629 n = prov_n(i)
630 ne = prov_e(i)
631 ims1 = bitget(mbinflg(ne),0)
632 ims2 = bitget(mbinflg(ne),1)
633 iss1 = bitget(nbinflg(n),0)
634 iss2 = bitget(nbinflg(n),1)
635 IF((ims1 == 1 .and. iss1==1).or.
636 . (ims2 == 1 .and. iss2==1))THEN
637 pene(i)=zero
638 ENDIF
639 ENDDO
640C
641 RETURN
bitget
integer function bitget(i, n)
Definition bitget.F:37