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