OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20sto.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20sto (j_stok, irect, xa, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, inacti, ifq, cand_a, cand_p, ifpen, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, curv_max, nin, gap_sh, nbinflg, mbinflg, isym)
subroutine i20sto_edge (j_stok, ixlins, ixlinm, xa, ii_stoke, cand_s, cand_m, nsn4, noint, tzinf, i_mem, prov_s, prov_m, eshift, addcm, chaine, nlinsa, nin)
subroutine i20pen3_edge (jlt, cand_n, cand_e, gap, xa, ixlins, ixlinm, pene, nlinsa, nin)
integer function bitget (i, n)

Function/Subroutine Documentation

◆ bitget()

integer function bitget ( integer i,
integer n )

Definition at line 498 of file i20sto.F.

499 INTEGER I,N
500 INTEGER S,I2P(0:12)! limite a 23 (cast reel pour spmd)
501 DATA i2p/1,2,4,8,16,32,64,128,256,512,1024,2048,4096/
502
503 s = i/i2p(n)
504 bitget = s - (s/2)*2
505 RETURN
bitget
integer function bitget(i, n)
Definition i20sto.F:499

◆ i20pen3_edge()

subroutine i20pen3_edge ( integer jlt,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
gap,
xa,
integer, dimension(2,*) ixlins,
integer, dimension(2,*) ixlinm,
pene,
integer nlinsa,
integer nin )

Definition at line 311 of file i20sto.F.

313C-----------------------------------------------
314C M o d u l e s
315C-----------------------------------------------
316 USE tri7box
317C-----------------------------------------------
318C I m p l i c i t T y p e s
319C-----------------------------------------------
320#include "implicit_f.inc"
321C-----------------------------------------------
322C G l o b a l P a r a m e t e r s
323C-----------------------------------------------
324#include "mvsiz_p.inc"
325C-----------------------------------------------
326C C o m m o n B l o c k s
327C-----------------------------------------------
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER JLT, NLINSA, NIN
332 INTEGER IXLINS(2,*), IXLINM(2,*),CAND_N(*),CAND_E(*)
333 my_real
334 . gap
335 my_real
336 . xa(3,*), pene(mvsiz)
337C-----------------------------------------------
338C L o c a l V a r i a b l e s
339C-----------------------------------------------
340 INTEGER I, IG,N1,N2,M1,M2,NI,L
341 my_real
342 . xs12,ys12,zs12,xm12,ym12,zm12,xxa,xxb,
343 . xs2,xm2,xsm,xs2m2,ys2,ym2,ysm,ys2m2,zs2,zm2,zsm,zs2m2,
344 . xx,yy,zz,als,alm,det,
345 . gap2, x11, x12, x13, x21, x22, x23,
346 . xmax1,ymax1,zmax1,xmax2,ymax2,zmax2,
347 . xmin1,ymin1,zmin1,xmin2,ymin2,zmin2,dd
348C-----------------------------------------------
349 gap2=gap*gap
350C--------------------------------------------------------
351C
352C--------------------------------------------------------
353C F = [A*X1+(1-A)*X2-B*X3-(1-B)*X4]^2 + [..Y..]^2 + [..Z..]^2
354C DF/DA = 0 = (X1-X2)(A(X1-X2)+X2-X4 +B(X4-X3))+...
355C DF/DA = 0 = A(X1-X2)^2 +X2-X4 + B(X1-X2)(X4-X3))+...
356C DF/DA = 0 = A[(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
357C + B[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
358C + (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
359C DF/DB = 0 = (X4-X3)(A(X1-X2)+X2-X4 +B(X4-X3))+...
360C DF/DB = 0 = B[(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
361C + A[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
362C + (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
363C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
364C XM2 = [(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
365C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
366C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
367C XB = (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
368C A XS2 + B XSM + XA = 0
369C A XSM + B XM2 + XB = 0
370C
371C A = -(XA + B XSM)/XS2
372C -(XA + B XSM)*XSM + B XM2*XS2 + XB*XS2 = 0
373C -B XSM*XSM + B XM2*XS2 + XB*XS2-XA*XSM = 0
374C B*(XM2*XS2 - XSM*XSM) = -XB*XS2+XA*XSM
375C B = (XA*XSM-XB*XS2) / (XM2*XS2 - XSM*XSM)
376C A = (XB*XSM-XA*XM2) / (XM2*XS2 - XSM*XSM)
377C--------------------------------------------------------
378C
379 DO i=1,jlt
380 l = cand_n(i)
381 IF(l<=nlinsa) THEN
382 n1=ixlins(1,cand_n(i))
383 n2=ixlins(2,cand_n(i))
384 x11 = xa(1,n1)
385 x12 = xa(2,n1)
386 x13 = xa(3,n1)
387 x21 = xa(1,n2)
388 x22 = xa(2,n2)
389 x23 = xa(3,n2)
390 ELSE
391 ni = l - nlinsa
392 x11 = xrem(2,ni)
393 x12 = xrem(3,ni)
394 x13 = xrem(4,ni)
395 x21 = xrem(10,ni)
396 x22 = xrem(11,ni)
397 x23 = xrem(12,ni)
398 END IF
399 m1=ixlinm(1,cand_e(i))
400 m2=ixlinm(2,cand_e(i))
401
402c calcul d'un minorant de la distance
403
404 xmax1 = max(x11,x21)
405 ymax1 = max(x12,x22)
406 zmax1 = max(x13,x23)
407 xmax2 = max(xa(1,m1),xa(1,m2))
408 ymax2 = max(xa(2,m1),xa(2,m2))
409 zmax2 = max(xa(3,m1),xa(3,m2))
410 xmin1 = min(x11,x21)
411 ymin1 = min(x12,x22)
412 zmin1 = min(x13,x23)
413 xmin2 = min(xa(1,m1),xa(1,m2))
414 ymin2 = min(xa(2,m1),xa(2,m2))
415 zmin2 = min(xa(3,m1),xa(3,m2))
416 dd = max(xmin1-xmax2,ymin1-ymax2,zmin1-zmax2,
417 . xmin2-xmax1,ymin2-ymax1,zmin2-zmax1)
418 IF(dd > gap)THEN
419 pene(i) = zero
420 cycle
421 ENDIF
422
423c calcul de la distance^2
424
425 xs12 = x21-x11
426 ys12 = x22-x12
427 zs12 = x23-x13
428 xs2m2 = xa(1,m2)-x21
429 ys2m2 = xa(2,m2)-x22
430 zs2m2 = xa(3,m2)-x23
431 xs2 = xs12*xs12 + ys12*ys12 + zs12*zs12
432 xm12 = xa(1,m2)-xa(1,m1)
433 ym12 = xa(2,m2)-xa(2,m1)
434 zm12 = xa(3,m2)-xa(3,m1)
435 xm2 = xm12*xm12 + ym12*ym12 + zm12*zm12
436 xsm = - (xs12*xm12 + ys12*ym12 + zs12*zm12)
437 xxa = xs12*xs2m2 + ys12*ys2m2 + zs12*zs2m2
438 xxb = -xm12*xs2m2 - ym12*ys2m2 - zm12*zs2m2
439 det = xm2*xs2 - xsm*xsm
440 det = max(em20,det)
441C
442 als = (xxb*xsm-xxa*xm2) / det
443 alm = (xxa*xsm-xxb*xs2) / det
444 xs2 = max(xs2,em20)
445 xm2 = max(xm2,em20)
446 IF(alm<zero)THEN
447 alm = zero
448 als = -xxa / xs2
449 ELSEIF(alm>one)THEN
450 alm = one
451 als = -(xxa + xsm) / xs2
452 ENDIF
453C
454 IF(als<zero)THEN
455 als = zero
456 alm = -xxb / xm2
457 ELSEIF(als>one)THEN
458 als = one
459 alm = -(xxb + xsm) / xm2
460 ENDIF
461
462 alm = min(one,alm)
463 alm = max(zero,alm)
464
465C PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
466
467 xx = als*x11 + (one-als)*x21
468 . - alm*xa(1,m1) - (one-alm)*xa(1,m2)
469 yy = als*x12 + (one-als)*x22
470 . - alm*xa(2,m1) - (one-alm)*xa(2,m2)
471 zz = als*x13 + (one-als)*x23
472 . - alm*xa(3,m1) - (one-alm)*xa(3,m2)
473 pene(i) = gap2- xx*xx - yy*yy - zz*zz
474C
475 END DO
476C
477 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ i20sto()

subroutine i20sto ( integer j_stok,
integer, dimension(4,*) irect,
xa,
integer, dimension(*) nsv,
integer ii_stok,
integer, dimension(*) cand_n,
integer, dimension(*) cand_e,
integer mulnsn,
integer noint,
marge,
integer i_mem,
integer, dimension(mvsiz) prov_n,
integer, dimension(mvsiz) prov_e,
integer eshift,
integer inacti,
integer ifq,
integer, dimension(*) cand_a,
cand_p,
integer, dimension(*) ifpen,
integer nsn,
integer, dimension(*) oldnum,
integer nsnrold,
integer igap,
gap,
gap_s,
gap_m,
gapmin,
gapmax,
curv_max,
integer nin,
gap_sh,
integer, dimension(*) nbinflg,
integer, dimension(*) mbinflg,
integer isym )

Definition at line 34 of file i20sto.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE tri7box
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50#include "comlock.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER I_MEM, NSN, NSNROLD,IGAP,NIN,ISYM
59 INTEGER J_STOK,MULNSN,NOINT,INACTI,IFQ,ESHIFT
60 INTEGER IRECT(4,*),NSV(*),CAND_N(*),CAND_E(*),CAND_A(*)
61 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),IFPEN(*), OLDNUM(*),
62 . NBINFLG(*),MBINFLG(*),II_STOK
63C REAL
64 my_real
65 . xa(3,*), cand_p(*), gap_s(*), gap_m(*), gap_sh(*),
66 . marge, gap, gapmin, gapmax,curv_max(*)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,K_STOK,I_STOK,N,NE,J,ISS1,ISS2,IMS1,IMS2
71 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
72C REAL
73 my_real
74 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
75 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
76 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
77 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
78 . pene(mvsiz), gapv(mvsiz)
79 INTEGER BITGET
80 EXTERNAL bitget
81C-----------------------------------------------
82 CALL i20cor3t(j_stok ,xa ,irect ,nsv ,prov_e ,
83 1 prov_n ,igap ,gap ,x1 ,x2 ,
84 2 x3 ,x4 ,y1 ,y2 ,y3 ,
85 3 y4 ,z1 ,z2 ,z3 ,z4 ,
86 4 xi ,yi ,zi ,stif ,ix1 ,
87 5 ix2 ,ix3 ,ix4 ,nsn ,gap_s ,
88 6 gap_m ,gapv ,gapmax,gapmin,curv_max,
89 7 nin ,gap_sh)
90C-----------------------------------------------
91 CALL i7pen3(j_stok ,marge ,x1 ,x2 ,x3 ,
92 . x4 ,y1 ,y2 ,y3 ,y4 ,
93 . z1 ,z2 ,z3 ,z4 ,xi ,
94 . yi ,zi ,pene ,ix1 ,ix2 ,
95 . ix3 ,ix4 ,igap ,gap ,gapv )
96C-----------------------------------------------
97C SUPPRESSION DES CANDIDATS AUTOIMPACTES S1 OU S2
98C-----------------------------------------------
99 IF(isym==1)THEN
100 DO i=1,j_stok
101 n = prov_n(i)
102 ne = prov_e(i)+eshift
103 ims1 = bitget(mbinflg(ne),0)
104 ims2 = bitget(mbinflg(ne),1)
105 IF(n <= nsn) THEN
106 iss1 = bitget(nbinflg(nsv(n)),0)
107 iss2 = bitget(nbinflg(nsv(n)),1)
108 ELSE
109 iss1 = bitget(nint(xrem(12,n-nsn)),0)
110 iss2 = bitget(nint(xrem(12,n-nsn)),1)
111 ENDIF
112 IF((ims1 == 0 .and. iss1==0).or.
113 . (ims2 == 0 .and. iss2==0))THEN
114 pene(i)=zero
115 ENDIF
116 ENDDO
117 ENDIF
118C-----------------------------------------------
119C SUPPRESSION DES ANCIENS CANDIDATS DEJA STOCKES (PENE INITIALE)
120C-----------------------------------------------
121 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq>0)THEN
122 DO i=1,j_stok
123 IF(pene(i)/=zero)THEN
124 n = prov_n(i)
125 ne = prov_e(i)+eshift
126 IF(n>nsn) THEN
127C numerotation tris precedent pour les noeuds non locaux (SPMD)
128 n = oldnum(n-nsn)+nsn
129 IF(n==nsn) n = nsn+nsnrold+1
130 END IF
131 j = cand_a(n)
132 DO WHILE(j<=cand_a(n+1)-1)
133 IF(cand_e(j)==ne)THEN
134 pene(i)=zero
135 j=cand_a(n+1)
136 ELSE
137 j=j+1
138 ENDIF
139 ENDDO
140 ENDIF
141 ENDDO
142 ENDIF
143C-----------------------------------------------
144 k_stok = 0
145 DO i=1,j_stok
146 IF(pene(i)/=zero) k_stok = k_stok + 1
147 ENDDO
148 IF(k_stok==0)RETURN
149C
150#include "lockon.inc"
151 i_stok = ii_stok
152 IF(i_stok+k_stok>mulnsn) THEN
153 i_mem = 2
154#include "lockoff.inc"
155 RETURN
156 ENDIF
157 ii_stok = i_stok + k_stok
158#include "lockoff.inc"
159C-----------------------------------------------
160 IF(ifq > 0 .AND.
161 . (inacti == 5 .OR. inacti ==6 .OR. inacti ==7))THEN
162 DO i=1,j_stok
163 IF(pene(i)/=0.0)THEN
164 i_stok = i_stok + 1
165 cand_n(i_stok) = prov_n(i)
166 cand_e(i_stok) = prov_e(i)+eshift
167 ifpen(i_stok) = 0
168 cand_p(i_stok) = zero
169 ENDIF
170 ENDDO
171 ELSEIF(ifq > 0)THEN
172 DO i=1,j_stok
173 IF(pene(i)/=zero)THEN
174 i_stok = i_stok + 1
175 cand_n(i_stok) = prov_n(i)
176 cand_e(i_stok) = prov_e(i)+eshift
177 ifpen(i_stok) = 0
178 ENDIF
179 ENDDO
180 ELSEIF(inacti==5.OR.inacti==6.OR.inacti==7)THEN
181 DO i=1,j_stok
182 IF(pene(i)/=zero)THEN
183 i_stok = i_stok + 1
184 cand_n(i_stok) = prov_n(i)
185 cand_e(i_stok) = prov_e(i)+eshift
186 cand_p(i_stok) = zero
187 ENDIF
188 ENDDO
189 ELSE
190 DO i=1,j_stok
191 IF(pene(i)/=zero)THEN
192 i_stok = i_stok + 1
193 cand_n(i_stok) = prov_n(i)
194 cand_e(i_stok) = prov_e(i)+eshift
195 ENDIF
196 ENDDO
197 ENDIF
198C-----------------------------------------------
199 RETURN
i20cor3t
subroutine i20cor3t(jlt, xa, irect, nsv, cand_e, cand_n, igap, gap, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsn, gap_s, gap_m, gapv, gapmax, gapmin, curv_max, nin, gap_sh)
Definition i20cor3t.F:38
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

◆ i20sto_edge()

subroutine i20sto_edge ( integer j_stok,
integer, dimension(2,*) ixlins,
integer, dimension(2,*) ixlinm,
xa,
integer ii_stoke,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
integer nsn4,
integer noint,
tzinf,
integer i_mem,
integer, dimension(mvsiz) prov_s,
integer, dimension(mvsiz) prov_m,
integer eshift,
integer, dimension(*) addcm,
integer, dimension(2,*) chaine,
integer nlinsa,
integer nin )

Definition at line 208 of file i20sto.F.

213C-----------------------------------------------
214C I m p l i c i t T y p e s
215C-----------------------------------------------
216#include "implicit_f.inc"
217#include "comlock.inc"
218C-----------------------------------------------
219C G l o b a l P a r a m e t e r s
220C-----------------------------------------------
221#include "mvsiz_p.inc"
222C-----------------------------------------------
223C D u m m y A r g u m e n t s
224C-----------------------------------------------
225 INTEGER I_MEM, NLINSA, NIN
226 INTEGER J_STOK,NSN4,NOINT
227 INTEGER IXLINS(2,*),IXLINM(2,*),CAND_S(*),CAND_M(*),ADDCM(*),
228 . CHAINE(2,*)
229 INTEGER PROV_S(MVSIZ),PROV_M(MVSIZ),ESHIFT,II_STOKE
230C REAL
231 my_real
232 . xa(3,*),tzinf
233C-----------------------------------------------
234C L o c a l V a r i a b l e s
235C-----------------------------------------------
236 INTEGER I,J,K_STOK,I_STOK,IAD0,IAD,IADFIN
237C REAL
238 my_real
239 . pene(mvsiz)
240C-----------------------------------------------
241 CALL i20pen3_edge(j_stok ,prov_s,prov_m,tzinf ,xa ,
242 . ixlins,ixlinm,pene ,nlinsa ,nin )
243C-----------------------------------------------
244C il faut un lock sur toute la boucle (modification de chaine)
245#include "lockon.inc"
246 k_stok = 0
247C-----------------------------------------------
248C elimination des couples deja trouves dans 1 boite precedente
249C-----------------------------------------------
250 i_stok = ii_stoke
251 iad0 = 0
252 DO i=1,j_stok
253 IF(pene(i)>zero)THEN
254 iad=addcm(prov_m(i))
255 j=0
256 DO WHILE(iad/=0.AND.j<nsn4)
257 j=j+1
258 IF(chaine(1,iad)==prov_s(i))THEN
259 pene(i) = zero
260 iad=0
261 ELSE
262 iad0=iad
263 iad=chaine(2,iad)
264 ENDIF
265 ENDDO
266 IF(pene(i)>zero)THEN
267 k_stok = k_stok + 1
268 iadfin=ii_stoke+1
269 IF(iadfin>nsn4) THEN
270 i_mem = 2
271#include "lockoff.inc"
272 RETURN
273 ENDIF
274 ii_stoke = iadfin
275 chaine(1,iadfin)=prov_s(i)
276 chaine(2,iadfin)=0
277 IF(addcm(prov_m(i))==0)THEN
278 addcm(prov_m(i))=iadfin
279 ELSE
280 chaine(2,iad0)=iadfin
281 ENDIF
282 ENDIF
283 ENDIF
284 ENDDO
285C
286 IF(k_stok==0) THEN
287#include "lockoff.inc"
288 RETURN
289 ENDIF
290C-----------------------------------------------
291 DO 200 i=1,j_stok
292 IF(pene(i)>zero)THEN
293 i_stok = i_stok + 1
294 cand_s(i_stok) = prov_s(i)
295 cand_m(i_stok) = prov_m(i)+eshift
296 ENDIF
297 200 CONTINUE
298C
299#include "lockoff.inc"
300C
301C-----------------------------------------------
302 RETURN
i20pen3_edge
subroutine i20pen3_edge(jlt, cand_n, cand_e, gap, xa, ixlins, ixlinm, pene, nlinsa, nin)
Definition i20sto.F:313