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

Go to the source code of this file.

Functions/Subroutines

subroutine i20ini3 (x, ixs, ixc, pm, geo, ipari, interface_id, itab, ms, mwa, rwa, ixtg, iwrn, ikine, ixt, ixp, ixr, nelemint, iddlevel, ifiend, nsnet, nmnet, iwcont, nsnt, nmnt, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ikine1, ipart, ipartc, iparttg, thk, thk_part, inpene, iwpentot, ixs10, i_mem, inter_cand, ixs16, ixs20, id, titr, kxx, ixx, igeo, nod2el1d, knod2el1d, lelx, intbuf_tab, pm_stack, iworksh, nspmd)

Function/Subroutine Documentation

◆ i20ini3()

subroutine i20ini3 ( x,
integer, dimension(nixs,*) ixs,
integer, dimension(nixc,*) ixc,
pm,
geo,
integer, dimension(*) ipari,
integer interface_id,
integer, dimension(*) itab,
ms,
integer, dimension(*) mwa,
rwa,
integer, dimension(nixtg,*) ixtg,
integer iwrn,
integer, dimension(*) ikine,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer nelemint,
integer iddlevel,
integer ifiend,
integer nsnet,
integer nmnet,
integer, dimension(*) iwcont,
integer nsnt,
integer nmnt,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) ikine1,
integer, dimension(*) ipart,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
thk,
thk_part,
integer inpene,
integer iwpentot,
integer, dimension(*) ixs10,
integer i_mem,
type(inter_cand_), intent(inout) inter_cand,
integer, dimension(*) ixs16,
integer, dimension(*) ixs20,
integer id,
character(len=nchartitle) titr,
integer, dimension(*) kxx,
integer, dimension(*) ixx,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) nod2el1d,
integer, dimension(*) knod2el1d,
lelx,
type(intbuf_struct_) intbuf_tab,
pm_stack,
integer, dimension(3,*) iworksh,
integer, intent(in) nspmd )
Parameters
[in]nspmdnuummber of mpi tasks
[in,out]inter_candstructure of pair of candidate

Definition at line 51 of file i20ini3.F.

64C-----------------------------------------------
65C M o d u l e s
66C-----------------------------------------------
67 USE message_mod
68 USE intbufdef_mod
69 USE groupdef_mod
70 USE inter_cand_mod
71 USE names_and_titles_mod , ONLY : nchartitle
72C-----------------------------------------------
73C I m p l i c i t T y p e s
74C-----------------------------------------------
75#include "implicit_f.inc"
76C-----------------------------------------------
77C G l o b a l P a r a m e t e r s
78C-----------------------------------------------
79#include "mvsiz_p.inc"
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83#include "com04_c.inc"
84#include "param_c.inc"
85#include "scr03_c.inc"
86#include "scr12_c.inc"
87#include "units_c.inc"
88#include "vect07_c.inc"
89C-----------------------------------------------
90C D u m m y A r g u m e n t s
91C-----------------------------------------------
92 INTEGER INTERFACE_ID, IWRN, NSNT, NMNT,SIXINT,
93 . NSNET ,NMNET, INPENE,IWPENTOT
94 INTEGER IXS(NIXS,*), IXC(NIXC,*),
95 . IPARI(*), IXT(NIXT,*) ,IXP(NIXP,*) ,IXR(NIXR,*),
96 . ITAB(*), MWA(*), IXTG(NIXTG,*), IKINE(*),
97 . NELEMINT, IDDLEVEL,IFIEND,
98 . IWCONT(*),
99 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
100 . NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
101 . IPART(*),IPARTC(*), IPARTTG(*),IXS10(*),I_MEM,
102 . IXS16(*), IXS20(*),KXX(*),IXX(*), IGEO(NPROPGI,*),
103 . NOD2EL1D(*), KNOD2EL1D(*),IWORKSH(3,*)
104 INTEGER IKINE1(*)
105 INTEGER, INTENT(in) :: NSPMD !< nuummber of mpi tasks
106C REAL
107 my_real
108 . x(*), pm(*), geo(*), ms(*),rwa(6,*),
109 . thk(*),thk_part(*),lelx(*),pm_stack(3,*)
110 TYPE(INTBUF_STRUCT_) INTBUF_TAB
111
112 INTEGER ID
113 CHARACTER(LEN=NCHARTITLE) :: TITR
114 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
115 TYPE(INTER_CAND_), INTENT(inout) :: INTER_CAND !< structure of pair of candidate
116C-----------------------------------------------
117C L o c a l V a r i a b l e s
118C-----------------------------------------------
119 INTEGER NRTS, NRTM, NSN, NMN, NMN0, NTY, NST, MST, IBUC, NOINT,
120 . NSNE, NMNE,NLINS,NLINM,NLN,IWPENE,IWPENEDGE,
121 . I, I_STOK,I_STOK_E,IRS,IRM,ILEV,IDEL2,
122 . NSEG, NGROUS, NG, INACTI,
123 . JLT_NEW,IGAP,MULTIMP,ISEARCH,ITIED,
124 . IGN,IGE,NME,NMES,NAD,EAD,ISU1,ISU2,
125 . INTTH,NLINSA,NLINMA,ISS2,IFS2,ISYM
126 integer
127 . n1(mvsiz),n2(mvsiz),m1(mvsiz),m2(mvsiz)
128 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG
129C REAL
130 my_real
131 . maxbox,minbox,gap0,bid,tzinf,gapinf,gap_tri,gapshmax,gapmax0,
132 . gapinfs,gapinfm,gape,gapinput,fpenmax,drad
133 my_real :: gap,gapmin,gapmax,dgapload
134 my_real
135 . nx(mvsiz),ny(mvsiz),nz(mvsiz),gapv(mvsiz),xanew(3,numnod)
136 my_real
137 . , DIMENSION(:,:), ALLOCATABLE :: solidn_normal
138
139 INTEGER, DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4
140 INTEGER, DIMENSION(MVSIZ) :: PROV_N,PROV_E,NSVG
141 my_real, DIMENSION(MVSIZ) :: x1,x2,x3,x4
142 my_real, DIMENSION(MVSIZ) :: y1,y2,y3,y4
143 my_real, DIMENSION(MVSIZ) :: z1,z2,z3,z4
144 my_real, DIMENSION(MVSIZ) :: n11,n21,n31
145 my_real, DIMENSION(MVSIZ) :: xi,yi,zi
146 my_real, DIMENSION(MVSIZ) :: x0,y0,z0
147 my_real, DIMENSION(MVSIZ) :: xx1,yy1,zz1
148 my_real, DIMENSION(MVSIZ) :: xx2,yy2,zz2
149 my_real, DIMENSION(MVSIZ) :: xx3,yy3,zz3
150 my_real, DIMENSION(MVSIZ) :: xx4,yy4,zz4
151 my_real, DIMENSION(MVSIZ) :: xn1,yn1,zn1
152 my_real, DIMENSION(MVSIZ) :: xn2,yn2,zn2
153 my_real, DIMENSION(MVSIZ) :: xn3,yn3,zn3
154 my_real, DIMENSION(MVSIZ) :: xn4,yn4,zn4
155 my_real, DIMENSION(MVSIZ) :: pene
156 my_real, DIMENSION(MVSIZ) :: p1,p2,p3,p4
157 my_real, DIMENSION(MVSIZ) :: lb1,lb2,lb3,lb4
158 my_real, DIMENSION(MVSIZ) :: lc1,lc2,lc3,lc4,stif
159C=======================================================================
160
161 bid = zero
162 iwpene=0
163 iwpenedge=0
164 nrts =ipari(3)
165 nrtm =ipari(4)
166 nsn =ipari(5)
167 nmn =ipari(6)
168 nmn0 =nmn
169 nty =ipari(7)
170 nst =ipari(8)
171 mst =ipari(9)
172 ibuc =ipari(12)
173 isearch=ipari(12)
174 noint =ipari(15)
175 igap =ipari(21)
176 inacti=ipari(22)
177 multimp=ipari(23)
178 irm =ipari(24)
179 irs =ipari(25)
180 idel2 =ipari(17)
181 ilev =ipari(20)
182 itied =0
183 isu1 =ipari(45)
184 isu2 =ipari(46)
185C
186 nln = ipari(35)
187 isym = ipari(43)
188 drad = zero
189
190 ALLOCATE(tag(numnod))
191 tag(1:numnod)=0
192
193 CALL i7err3(
194 1 x ,nrtm ,intbuf_tab%IRECTM ,noint ,itab,id,titr,
195 2 ix1 ,ix2 ,ix3 ,ix4 ,x1 ,
196 3 x2 ,x3 ,x4 ,y1 ,y2 ,
197 4 y3 ,y4 ,z1 ,z2 ,z3 ,
198 5 z4 ,n11 ,n21 ,n31 ,x0 ,
199 6 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
200 7 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
201 8 zn3 ,xn4 ,yn4 ,zn4 )
202C
203C CALCUL DES RIGIDITES ELEMENTTAIRES ET NODALES
204C
205 IF(isu2 /= 0 .and. isym == 1)THEN
206 ifs2 = 1
207 iss2 = isu2
208 ELSE
209 ifs2 = 0
210 iss2 = 1
211 ENDIF
212 gapinput = intbuf_tab%VARIABLES(2)
213 CALL i20sti3(
214 1 pm ,geo ,x ,ms ,
215 2 ixs ,ixc ,ixtg ,ixt ,
216 3 ixp ,rwa ,interface_id ,nty ,
217 4 noint ,nrtm ,nsn ,intbuf_tab%IRECTM ,
218 5 intbuf_tab%NSV ,inacti ,intbuf_tab%VARIABLES(2),igap ,
219 6 intbuf_tab%GAP_S ,intbuf_tab%GAP_M ,intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(6),
220 7 intbuf_tab%VARIABLES(16),intbuf_tab%STFAC(1) ,intbuf_tab%STFM ,intbuf_tab%STFA ,
221 8 knod2els ,knod2elc ,knod2eltg ,nod2els ,
222 9 nod2elc ,nod2eltg ,igrsurf(isu1) ,ifs2 ,
223 a igrsurf(iss2) ,ipari(47) ,intbuf_tab%IELES ,
224 b intbuf_tab%IELEC ,intbuf_tab%AREAS ,ipartc ,iparttg ,
225 c thk ,thk_part ,intbuf_tab%GAP_SH ,xanew ,
226 d gapshmax ,intbuf_tab%NBINFLG ,intbuf_tab%MBINFLG ,nln ,
227 e intbuf_tab%NLG ,intbuf_tab%VARIABLES(29),ixs10 ,ixs16 ,
228 f ixs20 ,id,titr,igeo, pm_stack , iworksh )
229 ipari(21) = igap
230C
231C IL FAUT ENCORE FAIRE ONE BUCKET SORT DANS LE STARTER
232C
233 maxbox = intbuf_tab%VARIABLES(9)
234 minbox = intbuf_tab%VARIABLES(12)
235 gapmax0 = intbuf_tab%VARIABLES(16) + gapshmax
236 CALL i7buc1(
237 1 x ,intbuf_tab%IRECTM,intbuf_tab%NSV,intbuf_tab%VARIABLES(4),nseg ,
238 2 nmn ,nrtm ,mwa ,nsn ,intbuf_tab%CAND_E,
239 3 intbuf_tab%CAND_N,intbuf_tab%VARIABLES(2),rwa ,noint ,i_stok ,
240 4 intbuf_tab%VARIABLES(5),intbuf_tab%VARIABLES(8),maxbox,minbox ,intbuf_tab%MSR,
241 5 intbuf_tab%STFM,intbuf_tab%STFA ,multimp ,1 ,iddlevel ,
242 6 itab ,intbuf_tab%GAP_S,intbuf_tab%GAP_M,igap,intbuf_tab%VARIABLES(13),
243 7 gapmax0 ,inacti ,bid ,bid,i_mem,id,titr, 0,prov_n,prov_e,
244 9 nsvg,ix1 ,ix2 ,ix3 ,ix4 ,
245 1 n11 ,n21 ,n31 ,pene ,x1 ,
246 2 x2 ,x3 ,x4 ,y1 ,y2 ,
247 3 y3 ,y4 ,z1 ,z2 ,z3 ,
248 4 z4 ,xi ,yi ,zi ,x0 ,
249 5 y0 ,z0 ,xn1 ,yn1 ,zn1 ,
250 6 xn2 ,yn2 ,zn2 ,xn3 ,yn3 ,
251 7 zn3 ,xn4 ,yn4 ,zn4 ,p1 ,
252 8 p2 ,p3 ,p4 ,lb1 ,lb2 ,
253 9 lb3 ,lb4 ,lc1 ,lc2 ,lc3 ,
254 1 lc4,stif)
255 if (i_mem == 2)RETURN
256
257 intbuf_tab%VARIABLES(9) = maxbox
258 intbuf_tab%VARIABLES(12) = minbox
259 ! -----------------
260 ! update the weight of candidate's pair for the domain decomposition
261 IF (iddlevel==0.AND.nspmd>1)THEN
262 IF ( ((nelemint+i_stok)) > inter_cand%S_IXINT_2) CALL upgrade_ixint(inter_cand,nelemint,i_stok)
263 gap = intbuf_tab%VARIABLES(2)
264 gapmin = intbuf_tab%VARIABLES(13)
265 gapmax = intbuf_tab%VARIABLES(16)
266 dgapload = intbuf_tab%VARIABLES(46)
267 CALL update_weight_inter_type7(nelemint,interface_id,nsn,nrtm,ifiend,
268 . intbuf_tab%IRECTM,intbuf_tab%NSV,i_stok,intbuf_tab%CAND_E,intbuf_tab%CAND_N,
269 . igap,gap,gapmax,gapmin,dgapload,
270 . drad,intbuf_tab%GAP_S,intbuf_tab%GAP_SL,intbuf_tab%GAP_M,intbuf_tab%GAP_ML,
271 . numnod,x,inter_cand)
272 ENDIF
273 ! -----------------
274
275 IF((iddlevel==0).AND. (dectyp>=3.AND.dectyp<=6))THEN
276C Appe routine poids noeuds interfaces
277 CALL i20wcontdd(intbuf_tab%NSV,intbuf_tab%MSR,nsn,nmn,iwcont,nsnt,nmnt)
278 END IF
279
280c----------------------------------------------------
281c Calcul des normales nodales
282c Igap/=0 pour solides (GAP=0)
283c----------------------------------------------------
284c IF(ICURV==3.or.IGAP/=0)THEN
285 IF(igap/=0)THEN
286 ALLOCATE(solidn_normal(3,numnod))
287 CALL i20norm(ipari(4),intbuf_tab%IRECTM,numnod,x,solidn_normal,
288 . ipari(6),intbuf_tab%MSR,nln,intbuf_tab%NLG,intbuf_tab%GAP_SH)
289 ENDIF
290C-----EDGES -------
291
292 nlins =ipari(51)
293 nlinm =ipari(52)
294 nlinsa =ipari(53)
295 nlinma =ipari(54)
296 nsne =ipari(55)
297 nmne =ipari(56)
298
299 IF(nlins + nlinm /= 0)THEN
300C CALCUL DES RIGIDITES ELEMENTTAIRES
301C
302 gap0 = gapinput
303 gape = gapinput
304 gapinfs = ep30
305 gapinfm = ep30
306 CALL i20sti3e(
307 1x ,intbuf_tab%IXLINM ,intbuf_tab%STF,ixs ,pm ,
308 2geo ,nlinm ,ixc ,interface_id ,intbuf_tab%STFAC(1),
309 3nty ,gape ,noint ,intbuf_tab%GAP_ME,
310 4ms ,ixtg ,ixt ,ixp ,ixr ,
311 5igap ,intbuf_tab%VARIABLES(13),gap0 ,gapinfs ,nsne ,
312 6ipartc ,iparttg ,thk ,thk_part ,ixs10 ,
313 7id ,titr ,kxx ,ixx ,igeo ,
314 8 nod2el1d ,knod2el1d ,knod2els ,knod2elc ,knod2eltg ,
315 9 nod2els ,nod2elc ,nod2eltg ,lelx , pm_stack , iworksh )
316C
317 CALL i20sti3e(
318 1x ,intbuf_tab%IXLINS,intbuf_tab%STFS,ixs ,pm ,
319 2geo ,nlins ,ixc ,-interface_id ,intbuf_tab%STFAC(1),
320 3nty ,gape ,noint ,intbuf_tab%GAP_SE,
321 4ms ,ixtg ,ixt ,ixp ,ixr ,
322 5igap ,intbuf_tab%VARIABLES(13),gap0 ,gapinfm ,nsne ,
323 6ipartc ,iparttg ,thk ,thk_part ,ixs10 ,
324 7id ,titr ,kxx ,ixx ,igeo ,
325 7 nod2el1d ,knod2el1d ,knod2els ,knod2elc ,knod2eltg ,
326 8 nod2els ,nod2elc ,nod2eltg ,lelx , pm_stack , iworksh)
327
328 intbuf_tab%VARIABLES(2) = max(intbuf_tab%VARIABLES(2),gape)
329 gapinf=gapinfs+gapinfm
330 gapinf=min(gapinf,intbuf_tab%VARIABLES(6))
331 intbuf_tab%VARIABLES(6)=max(gapinf,intbuf_tab%VARIABLES(13))
332C
333C IL FAUT ENCORE FAIRE ONE BUCKET SORT DANS LE STARTER
334C
335 maxbox = intbuf_tab%VARIABLES(9)
336 minbox = intbuf_tab%VARIABLES(12)
337 gap_tri = intbuf_tab%VARIABLES(2)
338c majoration temporaire du gap pour tri (gap shift)
339 IF(igap/=0)gap_tri=two*gap_tri
340 CALL i11buc1(
341 1x ,intbuf_tab%IXLINM,intbuf_tab%IXLINS,intbuf_tab%VARIABLES(4),nlinsa,
342 2nmne ,nlinma ,mwa ,nsne ,intbuf_tab%LCAND_N,
343 3intbuf_tab%LCAND_S,gap_tri ,rwa ,noint ,i_stok_e ,
344 4intbuf_tab%VARIABLES(5),intbuf_tab%VARIABLES(8),maxbox ,minbox ,intbuf_tab%MSRL,
345 5intbuf_tab%NSVL,multimp ,intbuf_tab%ADCCM20,intbuf_tab%CHAIN20,i_mem,
346 6id,titr,iddlevel,drad, 0)
347
348 if (i_mem == 2)RETURN
349 intbuf_tab%VARIABLES(9) = maxbox
350 intbuf_tab%VARIABLES(12) = minbox
351C------------------------------------------------------
352C CALCUL LES PENETRATIONS INITIALES
353C CORRECTION DE LA POSITION DES POINTS D'ANCRAGE
354C 1-EDGES
355C------------------------------------------------------
356
357 ngrous=1+(i_stok_e-1)/nvsiz
358C
359 IF(ipri>=1) WRITE(iout,2011)
360C
361 DO ng=1,ngrous
362 nft = (ng-1) * nvsiz
363 lft = 1
364 llt = min0( nvsiz, i_stok_e - nft )
365 jlt_new = 0
366 CALL i20dst3e(
367 1 llt ,intbuf_tab%VARIABLES(13),intbuf_tab%LCAND_S(1+nft) ,intbuf_tab%LCAND_N(1+nft),
368 . intbuf_tab%IXLINS,
369 2 intbuf_tab%IXLINM,nx ,ny ,nz ,
370 4 n1 ,n2 ,m1 ,m2 ,jlt_new ,
371 5 x ,igap ,intbuf_tab%GAP_SE ,intbuf_tab%GAP_ME,gapv,
372 6 nln ,intbuf_tab%NLG,solidn_normal)
373C
374 fpenmax = intbuf_tab%VARIABLES(27)
375 llt = jlt_new
376 CALL i20pwr3ae(itab ,inacti,intbuf_tab%LCAND_N(1+nft),intbuf_tab%LCAND_S(1+nft),
377 2 intbuf_tab%STFS,intbuf_tab%STF,xanew ,intbuf_tab%NSVL,iwpenedge,
378 3 n1 ,n2 ,m1 ,m2 ,nx ,
379 4 ny ,nz ,gapv ,intbuf_tab%GAP_SE,intbuf_tab%GAP_ME,
380 5 igap ,x ,fpenmax )
381 IF(iwpenedge/=0.AND.inacti==3.OR.inacti==4) iwrn = 1
382 ENDDO
383 IF(((iddlevel==0)).AND.(dectyp>=3.AND.dectyp<=6))THEN
384C Appel routine poids noeuds interfaces
385 CALL i20wcontdd(intbuf_tab%NSVL,intbuf_tab%MSRL,nsne,nmne,iwcont,
386 . nsnet,nmnet)
387 END IF
388 END IF
389C------------------------------------------------------
390C 2-NOEUDS FACETTES
391C------------------------------------------------------
392 IF(igap /= 0)CALL i20gap1(
393 1 nrtm ,nsn ,nln, intbuf_tab%GAP_M,intbuf_tab%GAP_SH,
394 2 intbuf_tab%GAP_S,intbuf_tab%NBINFLG,intbuf_tab%NSV,intbuf_tab%NLG,tag)
395
396 ngrous=1+(i_stok-1)/nvsiz
397C
398 DO ng=1,ngrous
399 IF(ipri>=1) WRITE(iout,2007)
400 nft = (ng-1) * nvsiz
401 lft = 1
402 llt = min0( nvsiz, i_stok - nft )
403 CALL i7cor3(
404 1 x,intbuf_tab%IRECTM,intbuf_tab%NSV,intbuf_tab%CAND_E(1+nft),intbuf_tab%CAND_N(1+nft),
405 2 intbuf_tab%STFM,intbuf_tab%STFA,gapv ,igap ,intbuf_tab%VARIABLES(2) ,
406 3 intbuf_tab%GAP_S,intbuf_tab%GAP_M,1,intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(16),
407 4 bid ,bid ,drad,ix1 ,ix2 ,
408 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
409 6 x3 ,x4 ,y1 ,y2 ,y3 ,
410 7 y4 ,z1 ,z2 ,z3 ,z4 ,
411 8 xi ,yi ,zi ,stif ,bid ,
412 9 llt)
413
414 CALL i20dst3(igap,intbuf_tab%GAP_SH,intbuf_tab%CAND_E(1+nft),intbuf_tab%CAND_N(1+nft),gapv ,
415 2 intbuf_tab%VARIABLES(2),intbuf_tab%GAP_S,intbuf_tab%GAP_M,intbuf_tab%VARIABLES(16),
416 . intbuf_tab%VARIABLES(13),
417 3 intbuf_tab%IRECTM,nln ,intbuf_tab%NLG,solidn_normal,intbuf_tab%NSV,
418 4 intbuf_tab%NBINFLG,tag,ix3 ,ix4 ,x1 ,
419 5 x2, x3, x4 ,y1 ,y2 ,
420 6 y3, y4, z1 ,z2 ,z3 ,
421 7 z4, xi, yi ,zi ,x0 ,
422 8 y0, z0, xn1,yn1,zn1,
423 9 xn2,yn2, zn2,xn3,yn3,
424 1 zn3,xn4, yn4,zn4,p1 ,
425 2 p2 ,p3 ,p4 ,lb1,lb2,
426 3 lb3,lb4,lc1 ,lc2,lc3,
427 4 lc4)
428 CALL i7pen3(zero,gapv,n11 ,n21 ,n31 ,
429 1 pene ,xn1 ,yn1,zn1,xn2,
430 2 yn2 ,zn2 ,xn3,yn3,zn3,
431 3 xn4 ,yn4 ,zn4,p1 ,p2 ,
432 4 p3 ,p4,llt)
433
434 fpenmax = intbuf_tab%VARIABLES(27)
435 CALL i20pwr3a(itab ,inacti,intbuf_tab%CAND_E(1+nft),intbuf_tab%CAND_N(1+nft),
436 . intbuf_tab%STFA ,
437 1 intbuf_tab%STFM,xanew,intbuf_tab%NSV,iwpene ,iwrn ,
438 2 intbuf_tab%CAND_E,intbuf_tab%CAND_N,mwa ,noint ,gapv ,
439 3 nty ,itied , fpenmax ,id,titr ,
440 4 ix1,ix2,ix3,ix4,x1,
441 5 x2 ,x3 ,x4 ,y1 ,y2,
442 6 y3 ,y4 ,z1 ,z2 ,z3,
443 7 z4 ,xi ,yi ,zi ,n11,
444 8 n21,n31,pene,nsvg)
445 ENDDO
446
447C------------------------------------------------------
448C RE-CALCUL LES PENETRATIONS INITIALES
449C APRES CORRECTION DE LA POSITION DES POINTS D'ANCRAGE
450C 1-NOEUDS FACETTES
451C------------------------------------------------------
452
453 ngrous=1+(i_stok-1)/nvsiz
454 iwpene =0
455 iwpenedge=0
456C
457 DO ng=1,ngrous
458 IF(ipri>=1) WRITE(iout,2007)
459 nft = (ng-1) * nvsiz
460 lft = 1
461 llt = min0( nvsiz, i_stok - nft )
462 CALL i7cor3(
463 1 xanew ,intbuf_tab%IRECTM,intbuf_tab%NSV,intbuf_tab%CAND_E(1+nft),intbuf_tab%CAND_N(1+nft),
464 2 intbuf_tab%STFM,intbuf_tab%STFA,gapv ,igap ,intbuf_tab%VARIABLES(2) ,
465 3 intbuf_tab%GAP_S,intbuf_tab%GAP_M,1,intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(16),
466 4 bid ,bid ,drad,ix1 ,ix2 ,
467 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
468 6 x3 ,x4 ,y1 ,y2 ,y3 ,
469 7 y4 ,z1 ,z2 ,z3 ,z4 ,
470 8 xi ,yi ,zi ,stif ,bid ,
471 9 llt)
472
473 CALL i20dst3(igap,intbuf_tab%GAP_SH,intbuf_tab%CAND_E(1+nft),intbuf_tab%CAND_N(1+nft),gapv ,
474 2 intbuf_tab%VARIABLES(2),intbuf_tab%GAP_S,intbuf_tab%GAP_M,intbuf_tab%VARIABLES(16),
475 . intbuf_tab%VARIABLES(13),
476 3 intbuf_tab%IRECTM,nln ,intbuf_tab%NLG,solidn_normal,intbuf_tab%NSV,
477 4 intbuf_tab%NBINFLG,tag,ix3 ,ix4 ,x1 ,
478 5 x2, x3, x4 ,y1 ,y2 ,
479 6 y3, y4, z1 ,z2 ,z3 ,
480 7 z4, xi, yi ,zi ,x0 ,
481 8 y0, z0, xn1,yn1,zn1,
482 9 xn2,yn2, zn2,xn3,yn3,
483 1 zn3,xn4, yn4,zn4,p1 ,
484 2 p2 ,p3 ,p4 ,lb1,lb2,
485 3 lb3,lb4,lc1 ,lc2,lc3,
486 4 lc4)
487
488 CALL i7pen3(zero,gapv,n11 ,n21 ,n31 ,
489 1 pene,xn1 ,yn1 ,zn1 ,xn2,
490 2 yn2 ,zn2 ,xn3 ,yn3 ,zn3,
491 3 xn4 ,yn4 ,zn4 ,p1 ,p2 ,
492 4 p3 ,p4,llt)
493
494 CALL i20pwr3(itab ,inacti,intbuf_tab%CAND_E(1+nft),intbuf_tab%CAND_N(1+nft),intbuf_tab%STFA,
495 1 intbuf_tab%STFM,xanew,intbuf_tab%NSV,iwpene ,iwrn ,
496 2 intbuf_tab%CAND_E,intbuf_tab%CAND_N,mwa ,noint ,gapv ,
497 3 nty ,itied ,intbuf_tab%PENIS,intbuf_tab%PENIM,intbuf_tab%GAP_S,
498 4 igap ,id ,titr,ix1,ix2,
499 5 ix3 ,ix4,n11 ,n21,n31,
500 6 pene,nsvg)
501 ENDDO
502 intbuf_tab%I_STOK(1)=iwpene
503
504C------------------------------------------------------
505C 2-EDGES
506C------------------------------------------------------
507 IF(nlins /= 0)THEN
508
509 ngrous=1+(i_stok_e-1)/nvsiz
510C
511 IF(ipri>=1) WRITE(iout,2011)
512C
513 DO ng=1,ngrous
514 nft = (ng-1) * nvsiz
515 lft = 1
516 llt = min0( nvsiz, i_stok_e - nft )
517 jlt_new = 0
518 CALL i20dst3e(
519 1 llt ,intbuf_tab%VARIABLES(13),intbuf_tab%LCAND_S(1+nft) ,intbuf_tab%LCAND_N(1+nft),
520 . intbuf_tab%IXLINS,
521 2 intbuf_tab%IXLINM,nx ,ny ,nz ,
522 4 n1 ,n2 ,m1 ,m2 ,jlt_new ,
523 5 xanew ,igap ,intbuf_tab%GAP_SE ,intbuf_tab%GAP_ME,gapv,
524 6 nln ,intbuf_tab%NLG,solidn_normal)
525 llt = jlt_new
526 CALL i20pwr3e(itab ,inacti,intbuf_tab%LCAND_S(1+nft),intbuf_tab%LCAND_N(1+nft),
527 2 intbuf_tab%STFS,intbuf_tab%STF,xanew ,intbuf_tab%NSVL,iwpenedge,
528 3 n1 ,n2 ,m1 ,m2 ,nx ,
529 4 ny ,nz ,gapv ,intbuf_tab%GAP_SE,intbuf_tab%GAP_ME,
530 5 intbuf_tab%PENISE,intbuf_tab%PENIME,igap )
531 IF(iwpenedge/=0.AND.inacti==3.OR.inacti==4) iwrn = 1
532 ENDDO
533 IF(((iddlevel==0)).AND.(dectyp>=3.AND.dectyp<=6))THEN
534C Appel routine poids noeuds interfaces
535 CALL i20wcontdd(intbuf_tab%NSVL,intbuf_tab%MSRL,nsne,nmne,iwcont,
536 . nsnet,nmnet)
537 END IF
538 END IF
539C-----------
540c replace global node by local node in NSV,IRECT,NSVE,LINE...
541 CALL i20nlg(nln,nrtm,nsn ,nlins ,nlinm ,
542 2 intbuf_tab%NLG,intbuf_tab%IRECTM,intbuf_tab%NSV,intbuf_tab%IXLINS,
543 2 intbuf_tab%IXLINM,
544 3 nmn ,nsne ,nmne ,intbuf_tab%MSR,intbuf_tab%NSVL,
545 4 intbuf_tab%MSRL,intbuf_tab%STFA,intbuf_tab%AVX_ANCR,xanew ,x ,
546 5 intbuf_tab%PENIA,intbuf_tab%ALPHAK)
547
548c IF(ICURV==3.OR.IADM/=.OR.IGAP/=0)THEN
549 IF(igap/=0)THEN
550 DEALLOCATE(solidn_normal)
551 END IF
552
553 iwpentot = iwpene + iwpenedge
554 DEALLOCATE(tag)
555C-----------
556 RETURN
557C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
558 2007 FORMAT(//' IMPACT CANDIDATES',/,
559 +' MAIN SECONDARY NODES '/
560 +' NODE ')
561 2011 FORMAT(//' IMPACT CANDIDATES',/,
562 +' MAIN NODES SECONDARY NODES ')
my_real
#define my_real
Definition cppsort.cpp:32
i20wcontdd
subroutine i20wcontdd(nsv, msr, nsn, nmn, iwcont, nsnt, nmnt)
Definition grid2mat.F:3089
i11buc1
subroutine i11buc1(x, irectm, irects, bumult, nrts, nmn, nrtm, mwa, nsn, cand_m, cand_s, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, nsv, multimp, addcm, chaine, i_mem, id, titr, iddlevel, drad, it19)
Definition i11buc1.F:389
i20pwr3ae
subroutine i20pwr3ae(itab, inacti, cand_m, cand_s, stfs, stfm, xanew, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, igap, x, fpenmax)
Definition i20pwr3.F:35
i20pwr3e
subroutine i20pwr3e(itab, inacti, cand_m, cand_s, stfs, stfm, x, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, penis, penim, igap)
Definition i20pwr3.F:552
i20pwr3
subroutine i20pwr3(itab, inacti, cand_e, cand_n, stfn, stf, x, nsv, iwpene, iwrn, cand_en, cand_nn, tag, noint, gapv, nty, itied, penis, penim, gap_s, igap, id, titr, ix1, ix2, ix3, ix4, n1, n2, n3, pene, nsvg)
Definition i20pwr3.F:411
i20pwr3a
subroutine i20pwr3a(itab, inacti, cand_e, cand_n, stfn, stf, xanew, nsv, iwpene, iwrn, cand_en, cand_nn, tag, noint, gapv, nty, itied, fpenmax, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, n1, n2, n3, pene, nsvg)
Definition i20pwr3.F:177
i20sti3e
subroutine i20sti3e(x, ixlin, stf, ixs, pm, geo, nrt, ixc, nintr, slsfac, nty, gapmax, noint, gap_sm, ms, ixtg, ixt, ixp, ixr, igap, gapmin, gap0, gapinf, nsne, ipartc, iparttg, thk, thk_part, ixs10, id, titr, kxx, ixx, igeo, nod2el1d, knod2el1d, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, lelx, pm_stack, iworksh)
Definition i20sti3.F:857
i20sti3
subroutine i20sti3(pm, geo, x, ms, ixs, ixc, ixtg, ixt, ixp, wa, nint, nty, noint, nrt, nsn, irect, nsv, inacti, gap, igap, gap_s, gap_m, gapmin, gapinf, gapmax, stfac, stf, stfn, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf1, ifs2, igrsurf2, intth, ieles, ielec, areas, ipartc, iparttg, thk, thk_part, gap_sh, xanew, gapshmax, nbinflg, mbinflg, nln, nlg, gapsol, ixs10, ixs16, ixs20, id, titr, igeo, pm_stack, iworksh)
Definition i20sti3.F:58
i20nlg
subroutine i20nlg(nln, nrtm, nsn, nlins, nlinm, nlg, irect, nsv, ixlins, ixlinm, nmn, nsne, nmne, msr, nsve, msre, stfa, dxanc, xanew, x, penia, alphak)
Definition i20sti3.F:1368
i7buc1
subroutine i7buc1(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, id, titr, it19, prov_n, prov_e, nsvg, ix1, ix2, ix3, ix4, n11, n12, n13, pene, 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, stif)
Definition i7buc1.F:58
i7err3
subroutine i7err3(x, nrtm, irect, noint, itab, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, n1, n2, n3, x0, y0, z0, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3, zn3, xn4, yn4, zn4)
Definition i7err3.F:42
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
groupdef_mod
Definition groupdef_mod.F:662
inter_cand_mod
Definition inter_cand_mod.F:38
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
i20dst3
subroutine i20dst3(igap, gap_sh, cand_e, cand_n, gapv, gap, gap_s, gap_m, gapmax, gapmin, irect, nln, nlg, solidn_normal, nsv, nbinflg, tag, 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)
Definition i20dst3.F:47
i20dst3e
subroutine i20dst3e(jlt, gap, cand_s, cand_m, irects, irectm, nx, ny, nz, n1, n2, m1, m2, jlt_new, x, igap, gap_s, gap_m, gapv2, nln, nlg, solidn_normal)
Definition i20dst3.F:996
i20gap1
subroutine i20gap1(nrtm, nsn, nln, gap_m, gap_sh, gap_s, nbinflg, nsv, nlg, tag)
Definition i20dst3.F:799
i20norm
subroutine i20norm(nrtm, irect, numnod, x, solidn_normal, nmn, msr, nln, nlg, gap_sh)
Definition i20dst3.F:846
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
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
update_weight_inter_type7
subroutine update_weight_inter_type7(nelemint, interface_id, nsn, nrtm, ifiend, irect, nsv, i_stok, cand_e, cand_n, igap, gap, gapmax, gapmin, dgapload, drad, gap_s, gap_s_l, gap_m, gap_m_l, numnod, x, inter_cand)
Definition update_weight_inter_type7.F:36
upgrade_ixint
subroutine upgrade_ixint(inter_cand, nelemint, new_size)
Definition upgrade_ixint.F:33