OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24sto.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 i24sto (j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, mulnsn, noint, marge, i_mem, prov_n, prov_e, eshift, v, nsn, gap_s, gap_m, curv_max, nin, pene_old, nbinflg, mbinflg, ilev, msegtyp, edge_l2, iedge, iseadd, isedge, cand_t, itab, cand_a, oldnum, nsnrold, dgapload)
subroutine i24s1s2 (llt, nsn, eshift, prov_n, prov_e, nbinflg, mbinflg, pene)
subroutine i24edgt (llt, nsn, eshift, prov_n, prov_e, mbinflg, iseadd, isedge, pene_e, iedge)

Function/Subroutine Documentation

◆ i24edgt()

subroutine i24edgt ( integer llt,
integer nsn,
integer eshift,
integer, dimension(*) prov_n,
integer, dimension(*) prov_e,
integer, dimension(*) mbinflg,
integer, dimension(*) iseadd,
integer, dimension(*) isedge,
pene_e,
integer iedge )

Definition at line 255 of file i24sto.F.

257C-----------------------------------------------
258C M o d u l e s
259C-----------------------------------------------
260 USE tri7box
261C-----------------------------------------------
262C I m p l i c i t T y p e s
263C-----------------------------------------------
264#include "implicit_f.inc"
265C-----------------------------------------------
266C D u m m y A r g u m e n t s
267C-----------------------------------------------
268 INTEGER LLT,NSN,ESHIFT,PROV_N(*),PROV_E(*),MBINFLG(*),
269 . ISEADD(*) ,ISEDGE(*),IEDGE
270C REAL
271 my_real
272 . pene_e(*)
273C-----------------------------------------------
274C L o c a l V a r i a b l e s
275C-----------------------------------------------
276 INTEGER I,N,NE,IME,NES,IAD
277C REAL
278C-----------------------------------------------
279 INTEGER BITGET
280 EXTERNAL bitget
281C=======================================================================
282 IF(iedge==0)THEN
283 DO i=1,llt
284 pene_e(i)=zero
285 ENDDO
286 ELSE
287 DO i=1,llt
288 n = prov_n(i)
289 ne = prov_e(i)+eshift
290 ime = bitget(mbinflg(ne),8)
291 IF(n <= nsn) THEN
292 iad = iseadd(n)
293 nes = isedge(iad)
294 ELSE
295c a faire !!!!!!!!!!!!!!!!!!!!!!!!!
296 stop 987
297 ENDIF
298 IF(ime /= 1 .or. nes == 0) pene_e(i)=zero
299 ENDDO
300 ENDIF
301
302 RETURN
bitget
integer function bitget(i, n)
Definition bitget.F:37
my_real
#define my_real
Definition cppsort.cpp:32

◆ i24s1s2()

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

Definition at line 200 of file i24sto.F.

202C-----------------------------------------------
203C M o d u l e s
204C-----------------------------------------------
205 USE tri7box
206C-----------------------------------------------
207C I m p l i c i t T y p e s
208C-----------------------------------------------
209#include "implicit_f.inc"
210C-----------------------------------------------
211C D u m m y A r g u m e n t s
212C-----------------------------------------------
213 INTEGER LLT,NSN,ESHIFT,PROV_N(*),PROV_E(*),NBINFLG(*),MBINFLG(*)
214C REAL
215C-----------------------------------------------
216C L o c a l V a r i a b l e s
217C-----------------------------------------------
218 INTEGER I,N,NE,IMS1,IMS2,ISS1,ISS2
219C REAL
220C-----------------------------------------------
221 my_real
222 . pene(*)
223 INTEGER BITGET
224 EXTERNAL bitget
225C=======================================================================
226 DO i=1,llt
227 n = prov_n(i)
228 ne = prov_e(i)+eshift
229 ims1 = bitget(mbinflg(ne),0)
230 ims2 = bitget(mbinflg(ne),1)
231 IF(n <= nsn) THEN
232 iss1 = bitget(nbinflg(n),0)
233 iss2 = bitget(nbinflg(n),1)
234 ELSE
235 iss1 = bitget(irem(i24iremp+3,n-nsn),0)
236 iss2 = bitget(irem(i24iremp+3,n-nsn),1)
237 ENDIF
238 IF((ims1 == 1 .and. iss1==1).or.
239 . (ims2 == 1 .and. iss2==1))THEN
240 pene(i)=zero
241 ENDIF
242 ENDDO
243C
244 RETURN
tri7box::i24iremp
integer i24iremp
Definition tri7box.F:423
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339

◆ i24sto()

subroutine i24sto ( integer j_stok,
integer, dimension(4,*) irect,
x,
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,
v,
integer nsn,
gap_s,
gap_m,
curv_max,
integer nin,
pene_old,
integer, dimension(*) nbinflg,
integer, dimension(*) mbinflg,
integer ilev,
integer, dimension(*) msegtyp,
edge_l2,
integer iedge,
integer, dimension(*) iseadd,
integer, dimension(*) isedge,
integer, dimension(*) cand_t,
integer, dimension(*) itab,
integer, dimension(*) cand_a,
integer, dimension(*) oldnum,
integer nsnrold,
intent(in) dgapload )

Definition at line 35 of file i24sto.F.

43C============================================================================
44 USE tri7box
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER I_MEM, NSN, NIN,NBINFLG(*),MBINFLG(*),ILEV
58 INTEGER J_STOK,MULNSN,NOINT,ESHIFT,IEDGE,NSNROLD
59 INTEGER IRECT(4,*),NSV(*),CAND_N(*),CAND_E(*),CAND_T(*)
60 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),II_STOK,MSEGTYP(*),ISEADD(*),
61 . ISEDGE(*) ,itab(*), CAND_A(*),OLDNUM(*)
62C REAL
63 my_real , INTENT(IN) :: dgapload
64 my_real
65 . x(3,*), v(3,*), gap_s(*), gap_m(*),
66 . marge, curv_max(*),pene_old(5,nsn),edge_l2(*)
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,ITYPE,ISH
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), gapve(mvsiz), pene_e(mvsiz)
79 DATA itype/24/
80C-----------------------------------------------
81 CALL i24cor3t( j_stok ,x ,irect ,nsv ,prov_e ,
82 1 prov_n ,x1 ,x2 ,
83 2 x3 ,x4 ,y1 ,y2 ,y3 ,
84 3 y4 ,z1 ,z2 ,z3 ,z4 ,
85 4 xi ,yi ,zi ,stif ,ix1 ,
86 5 ix2 ,ix3 ,ix4 ,nsn ,gap_s ,
87 6 gap_m ,gapv ,curv_max,itype ,nin ,
88 7 v ,pene_old,gapve ,edge_l2,iedge ,
89 8 dgapload)
90C-----------------------------------------------
91 CALL i24pen3( 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 ,gapv ,gapve ,pene_e)
96C-----------------------------------------------
97 IF (ilev==2)
98 . CALL i24s1s2(j_stok,nsn,eshift,prov_n,prov_e,
99 . nbinflg,mbinflg,pene)
100 CALL i24edgt(j_stok ,nsn ,eshift ,prov_n,prov_e,
101 . mbinflg,iseadd ,isedge ,pene_e,iedge )
102
103C-----------------------------------------------
104C SUPPRESSION DES ANCIENS CANDIDATS DEJE STOCKES
105C-----------------------------------------------
106 DO i=1,j_stok
107 IF(pene(i)/=zero)THEN
108 n = prov_n(i)
109 ne = prov_e(i)+eshift
110 IF(n>nsn)THEN
111C numerotation tris precedent pour les noeuds non locaux (SPMD)
112 n = oldnum(n-nsn)+nsn
113 IF(n==nsn) n = nsn+nsnrold+1
114 END IF
115 j = cand_a(n)
116 DO WHILE(j<=cand_a(n+1)-1)
117 IF(cand_e(j)==ne)THEN
118 pene(i)=zero
119 j=cand_a(n+1)
120 ELSE
121 j=j+1
122 ENDIF
123 ENDDO
124 ENDIF
125 ENDDO
126
127 k_stok = 0
128 DO i=1,j_stok
129 IF(pene(i)+pene_e(i)/=zero) THEN
130 k_stok = k_stok + 1
131 IF( msegtyp(prov_e(i)+eshift)>0) k_stok = k_stok + 1
132 END IF
133 ENDDO
134 IF(k_stok==0)RETURN
135C
136#include "lockon.inc"
137 i_stok = ii_stok
138 IF(i_stok+k_stok>mulnsn) THEN
139 i_mem = 2
140#include "lockoff.inc"
141 RETURN
142 ENDIF
143 ii_stok = i_stok + k_stok
144#include "lockoff.inc"
145 IF(iedge==0)THEN
146 DO i=1,j_stok
147 IF(pene(i)/=zero)THEN
148 i_stok = i_stok + 1
149 cand_n(i_stok) = prov_n(i)
150 cand_e(i_stok) = prov_e(i)+eshift
151 ish=msegtyp(cand_e(i_stok))
152 IF( ish > 0 ) THEN
153 i_stok = i_stok + 1
154 cand_n(i_stok) = prov_n(i)
155 cand_e(i_stok) = ish
156 END IF
157 ENDIF
158 ENDDO
159 ELSE
160 DO i=1,j_stok
161 IF(pene(i)+pene_e(i) /= zero )THEN
162 i_stok = i_stok + 1
163 cand_n(i_stok) = prov_n(i)
164 cand_e(i_stok) = prov_e(i)+eshift
165 ish=msegtyp(cand_e(i_stok))
166 IF(pene_e(i) == zero)THEN
167 cand_t(i_stok) = 0 ! only node candidate
168 ELSEIF(pene(i) == zero)THEN
169 cand_t(i_stok) = 2 ! only edge candidate
170 ELSE
171 cand_t(i_stok) = 1 ! edge and node candidate
172 ENDIF
173 IF( ish > 0 ) THEN
174 i_stok = i_stok + 1
175 cand_n(i_stok) = prov_n(i)
176 cand_e(i_stok) = ish
177 IF(pene_e(i) == zero)THEN
178 cand_t(i_stok) = 0 ! only node candidate
179 ELSEIF(pene(i) == zero)THEN
180 cand_t(i_stok) = 2 ! only edge candidate
181 ELSE
182 cand_t(i_stok) = 1 ! edge and node candidate
183 ENDIF
184 END IF
185 ENDIF
186 ENDDO
187 ENDIF
188C-----------------------------------------------
189 RETURN
i24cor3t
subroutine i24cor3t(jlt, x, irect, nsv, cand_e, cand_n, 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, curv_max, ityp, nin, v, pene_old, gapve, edge_l2, iedge, dgapload)
Definition i24cor3t.F:39
i24edgt
subroutine i24edgt(llt, nsn, eshift, prov_n, prov_e, mbinflg, iseadd, isedge, pene_e, iedge)
Definition i24sto.F:257
i24s1s2
subroutine i24s1s2(llt, nsn, eshift, prov_n, prov_e, nbinflg, mbinflg, pene)
Definition i24sto.F:202
i24pen3
subroutine i24pen3(x, irect, gapv, cand_e, cand_n, nsv, inacti, itab, tag, iwpene, nsn, irtlm, msegtyp, iwpene0, pmin, gap_n, mvoisn, ixs, ixs10, ixs16, ixs20, penmax, penmin, id, titr, ilev, pen_old, knod2els, nod2els, ipartns, ipen0, icont_i, xfic, nrtm, irtse, is2se)
Definition i24pen3.F:46