OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintr.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr12_c.inc"
#include "scr15_c.inc"
#include "units_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inintr (ipari, inscr, x, v, ixs, ixq, ixc, pm, geo, itab, ms, mwa, rwa, ixtg, ikine, ixt, ixp, ixr, ale_connectivity, nelemint, iddlevel, ifiend, igrbric, iwcont, iwcin2, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ielem21, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, nod2el1d, knod2el1d, ixs10, inter_cand, frigap, ixs16, ixs20, ipm, nom_opt, iparts, siskwn, kxx, ixx, igeo, intercep, lelx, intbuf_tab, fillsol, stack, iworksh, nsnt, nmnt, kxig3d, ixig3d, knod2elq, nod2elq, segquadfr, tagprt_fric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, nsn_multi_connec, t2_nb_connec, sicode, icode, iskew, multi_fvm, s_nod2els, sitab, sitabm1, flag_elem_inter25, list_nin25, iresp)

Function/Subroutine Documentation

◆ inintr()

subroutine inintr ( integer, dimension(npari,ninter) ipari,
type(scratch_struct_), dimension(*) inscr,
x,
v,
integer, dimension(*) ixs,
integer, dimension(*) ixq,
integer, dimension(*) ixc,
pm,
geo,
integer, dimension(sitab) itab,
ms,
integer, dimension(*) mwa,
rwa,
integer, dimension(*) ixtg,
integer, dimension(*) ikine,
integer, dimension(*) ixt,
integer, dimension(*) ixp,
integer, dimension(*) ixr,
type(t_ale_connectivity), intent(inout) ale_connectivity,
integer nelemint,
integer iddlevel,
integer ifiend,
type (group_), dimension(ngrbric) igrbric,
integer, dimension(5,*) iwcont,
integer, dimension(2,*) iwcin2,
integer, dimension(*) knod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(s_nod2els) nod2els,
integer, dimension(*) nod2elc,
integer, dimension(*) nod2eltg,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) ielem21,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
integer, dimension(*) ipart,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
thk,
thk_part,
integer, dimension(*) nod2el1d,
integer, dimension(*) knod2el1d,
integer, dimension(*) ixs10,
type(inter_cand_), intent(inout) inter_cand,
frigap,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) iparts,
integer, intent(in) siskwn,
integer, dimension(*) kxx,
integer, dimension(*) ixx,
integer, dimension(*) igeo,
type(intersurfp), dimension(3,ninter) intercep,
lelx,
type(intbuf_struct_), dimension(*) intbuf_tab,
fillsol,
type(stack_ply), intent(inout) stack,
integer, dimension(*) iworksh,
integer nsnt,
integer nmnt,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(*) ixig3d,
integer, dimension(*) knod2elq,
integer, dimension(*) nod2elq,
integer, dimension(2,*) segquadfr,
integer, dimension(*) tagprt_fric,
type(intbuf_fric_struct_), dimension(*) intbuf_fric_tab,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartx,
integer, dimension(*) ipartr,
integer nsn_multi_connec,
integer, dimension(*) t2_nb_connec,
integer, intent(in) sicode,
integer, dimension(*) icode,
integer, dimension(siskwn) iskew,
type(multi_fvm_struct) multi_fvm,
integer s_nod2els,
integer, intent(in) sitab,
integer, intent(in) sitabm1,
integer, dimension(ninter25,numels), intent(in) flag_elem_inter25,
integer, dimension(ninter), intent(in) list_nin25,
integer, intent(in) iresp )
Parameters
[in]siskwnarray size
s_nod2elssize of NOD2ELS
[in,out]stackstack data structure

Definition at line 48 of file inintr.F.

65C-----------------------------------------------
66C M o d u l e s
67C-----------------------------------------------
68 USE my_alloc_mod
69 USE message_mod
70 USE intbufmod
71 USE front_mod
72 USE intbufdef_mod
73 USE intbufscratch_mod
74 USE intbuf_fric_mod
75 USE groupdef_mod
76 USE inoutfile_mod
77 USE ale_connectivity_mod
78 USE multi_fvm_mod
79 USE inter_cand_mod
80 USE names_and_titles_mod , ONLY : nchartitle
81 USE int18_law151_nsv_shift_mod , ONLY : int18_law151_nsv_shift
82 use stack_mod , only : stack_ply
83C-----------------------------------------------
84C I m p l i c i t T y p e s
85C-----------------------------------------------
86#include "implicit_f.inc"
87C-----------------------------------------------
88C C o m m o n B l o c k s
89C-----------------------------------------------
90#include "com01_c.inc"
91#include "com04_c.inc"
92#include "param_c.inc"
93#include "scr12_c.inc"
94#include "scr15_c.inc"
95#include "units_c.inc"
96#include "scr17_c.inc"
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 INTEGER,INTENT(IN) :: SITAB, SICODE, SITABM1, SISKWN !< array size
101 INTEGER :: S_NOD2ELS !< size of NOD2ELS
102 INTEGER IPARI(NPARI,NINTER), IXS(*), IXQ(*),
103 . IXC(*), ITAB(SITAB), MWA(*), IXTG(*), IKINE(*),
104 . IWCONT(5,*),IWCIN2(2,*),
105 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
106 . NOD2ELS(S_NOD2ELS), NOD2ELC(*), NOD2ELTG(*),
107 . IXT(*), IXP(*), IXR(*), NELEMINT, IDDLEVEL,IFIEND,
108 . IELEM21(*),IPM(NPROPMI,NUMMAT),
109 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*), IPART(*),
110 . IPARTC(*), IPARTTG(*),NOD2EL1D(*),KNOD2EL1D(*), IXS10(*),I_MEM,
111 . RESORT , IXS16(8,*), IXS20(12,*),IPARTS(*),IGEO(*),
112 . IWORKSH(*),NSNT, NMNT,KXIG3D(NIXIG3D,*),IXIG3D(*),
113 . KNOD2ELQ(*),NOD2ELQ(*),SEGQUADFR(2,*),TAGPRT_FRIC(*),IPARTT(*),
114 . IPARTP(*),IPARTX(*),IPARTR(*),NSN_MULTI_CONNEC,T2_NB_CONNEC(*),
115 . ICODE(*), ISKEW(SISKWN)
116 my_real x(3,*),v(3,*), pm(*), geo(*), ms(*), rwa(6,*),
117 . thk(*),thk_part(*),frigap(nparir,ninter),
118 . lelx(*), fillsol(*)
119 INTEGER NOM_OPT(LNOPT1,*),KXX(*),IXX(*)
120 INTEGER, INTENT(IN) :: LIST_NIN25(NINTER)
121 INTEGER, INTENT(IN) :: FLAG_ELEM_INTER25(NINTER25,NUMELS)
122 INTEGER , INTENT(IN) :: IRESP
123 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
124 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
125 TYPE(SCRATCH_STRUCT_) INSCR(*)
126 TYPE(INTBUF_FRIC_STRUCT_) INTBUF_FRIC_TAB(*)
127C-----------------------------------------------
128 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
129 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
130 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
131 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
132 TYPE(INTER_CAND_), INTENT(inout) :: INTER_CAND
133 type(stack_ply), intent(inout) :: stack !< stack data structure
134C-----------------------------------------------
135C L o c a l V a r i a b l e s
136C-----------------------------------------------
137 INTEGER,DIMENSION(:), ALLOCATABLE :: ITABM1
138 INTEGER N, JINSCR, NIN,IWRN, I
139 INTEGER NTY, NSN2T, NMN2T,ID,
140 . NSNET ,NMNET ,MULTIMP, IREMNODE, NREMNODE,
141 . NREMN(NINTER),ST2_CONNEC,
142 . REMNODE_SIZE,LEN_FILNAM,REMNODE_SIZE_EDG,IREMNODE_EDG,NIN25
143 CHARACTER*(2148) FILNAM
144 CHARACTER(LEN=NCHARTITLE) :: TITR
145 INTEGER, DIMENSION(:),ALLOCATABLE :: T2_ADD_CONNEC,T2_CONNEC,IKINE1
146
147 INTEGER :: NS
148 INTEGER :: NSN,NMN
149 LOGICAL :: CONDITION(NINTER)
150 my_real :: v1(3),v2(3)
151 INTEGER :: f1,f2
152 my_real :: displacement,displacement_max
153 INTEGER :: NRTM
154 INTEGER :: MAIN_INTERFACE_SIZE
155 INTEGER :: ID_MAIN_INTERFACE
156 INTEGER :: CPT,NODE_ID,J
157 INTEGER :: IPARI_14,INACTI
158 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG
159 DOUBLE PRECISION :: avg_stiff(NINTER)
160 DOUBLE PRECISION :: main_stiff
161 DOUBLE PRECISION :: min_stiff
162 LOGICAL :: IS_INTER18_AND_LAW151
163 INTEGER :: FLAG_OUTPUT !< flag for output
164 LOGICAL :: FLAG_REMOVED_NODE !< flag to remove some S node from the list of candidates
165 INTEGER :: IJK
166 INTEGER :: KIND_INTERFACE
167 INTEGER, DIMENSION(3) :: NEXT_INTER ! number of interface (3 different kinds of interface : type2,type24 and other)
168 INTEGER, DIMENSION(3) :: ADDRESS_INTER ! address in the INTERFACE_INDEX array
169 INTEGER, DIMENSION(NINTER) :: INTERFACE_TYPE2,INTERFACE_TYPE24,INTERFACE_OTHER ! interfaces, savec according to theirs types
170 INTEGER, DIMENSION(NINTER) :: INTERFACE_INDEX ! index of interface : other : 1-->next_inter(1), type2 : next_inter(1)+1--> next_inter(2), type24 : next_inter(1)+(2)--> next_inter(1)+(2)+(3)
171 INTEGER :: INTER_TYPE2_NUMBER !<number of interface type 2
172 INTEGER(KIND=8) :: NREMNODE_KIND8
173 INTEGER :: IEDGE !< check if edge to edge is used by the interface
174 INTEGER :: SKIP_TYPE25_EDGE_2_EDGE !< flag to activate only the computation of interface type 25 with edge to edge
175 INTEGER, DIMENSION(:), ALLOCATABLE :: ELEM_LINKED_TO_SEGMENT
176C-----------------------------------------------
177 CALL my_alloc(itabm1,sitabm1)
178C
179 i_mem = 0
180 resort = 0
181 nremnode = 0
182 ALLOCATE(ikine1(3*numnod))
183 DO i=1,3*numnod
184 ikine1(i) = 0
185 ENDDO
186C-----------------------------------------------
187 IF(((iddlevel == 0)) .AND. (dectyp >= 3 .AND. dectyp <= 6) .AND. n2d == 0)THEN
188 nsnt = 0
189 nmnt = 0
190 nsn2t = 0
191 nmn2t = 0
192 nsnet = 0
193 nmnet = 0
194 DO i = 1, numnod
195 iwcont(1,i) = 0
196 iwcont(2,i) = 0
197 iwcont(3,i) = 0
198 iwcont(4,i) = 0
199 iwcin2(1,i) = 0
200 iwcin2(2,i) = 0
201 END DO
202 END IF
203
204C----------------------Treatment for TYPE2 spt27/28 compatibility check - computation of size and allocation of array
205 IF (nsn_multi_connec > 0) THEN
206 ALLOCATE (t2_add_connec(numnod))
207 t2_add_connec(1:numnod) = 0
208 st2_connec = 0
209 t2_add_connec(1) = 1
210 IF (t2_nb_connec(1)>1) st2_connec = 1 + 5*t2_nb_connec(1)
211 DO i=2,numnod
212C-- only potential multiple connections are counted - nodes with only one connections are not counted -> nb of connections set to 0
213 IF (t2_nb_connec(i) == 1) t2_nb_connec(i) = 0
214C--
215 st2_connec = st2_connec + 1 + 5*t2_nb_connec(i)
216 t2_add_connec(i) = t2_add_connec(i-1) + 1 + 5*t2_nb_connec(i-1)
217 ENDDO
218 ALLOCATE (t2_connec(st2_connec))
219 t2_connec(1:st2_connec) = 0
220 ELSE
221 st2_connec = 0
222 ALLOCATE (t2_add_connec(0),t2_connec(0))
223 ENDIF
224
225C-----------------------------------------------
226 ALLOCATE( elem_linked_to_segment(numels) )
227 ! ----------------
228 ! loop over the interfaces
229 ! interface type 24 & 25 must be treated at the end
230 ! interface type 2 must be treated before interface 24
231 ! other interfaces are treated at the beginning
232 skip_type25_edge_2_edge = 0
233 next_inter(1:3) = 0
234 DO n=1,ninter
235 nty=ipari(7,n)
236 IF(nty==2) THEN
237 next_inter(2) = next_inter(2) + 1
238 interface_type2(next_inter(2)) = n
239 ELSEIF(nty == 24 .OR. nty == 25) THEN
240 next_inter(3) = next_inter(3) + 1
241 interface_type24(next_inter(3)) = n
242 IF(nty == 25) THEN
243 ! special case : interface type 25 with edge to edge
244 ! LEDGE array is initialized during the sorting
245 ! i7remnode algo for interface type 25 with edge to edge must be done after the %LEDGE initialization
246 iedge = ipari(58,n)
247 IF(iedge/=0) skip_type25_edge_2_edge = 1
248 ENDIF
249 ELSE
250 next_inter(1) = next_inter(1) + 1
251 interface_other(next_inter(1)) = n
252 ENDIF
253 ENDDO
254
255 address_inter(1) = 0
256 address_inter(2) = next_inter(1)
257 address_inter(3) = next_inter(1) + next_inter(2)
258 interface_index(1:next_inter(1)) = interface_other(1:next_inter(1))
259 interface_index(address_inter(2)+1:address_inter(2)+next_inter(2)) = interface_type2(1:next_inter(2))
260 interface_index(address_inter(3)+1:address_inter(3)+next_inter(3)) = interface_type24(1:next_inter(3))
261 ! ----------------
262 iwrn = 0
263 inter_type2_number = 0
264 nremn(1:ninter) = 0
265 ! ----------------
266 ! loop over the interfaces
267 ! 1) interface type 1,3:6,8:23
268 ! forbidden S nodes (defined in remnode structure) will BE take into account in the domain decomposition
269 ! 2) interface type 2
270 ! at the end of the interface type 2 treatment, update :
271 ! a) remnode algo for interface type 2
272 ! b) remnode algo for interface type 24
273 ! 3) interface type 24 / 25
274 ! forbidden S nodes (defined in remnode structure) will not be take into account in the domain decomposition
275 DO kind_interface=1,3
276
277 ! ----------------
278 DO ijk=1,next_inter(kind_interface)
279 n = interface_index(address_inter(kind_interface)+ijk)
280 iremnode = 0
281 iremnode_edg = 0
282 nremnode = 0
283 nty=ipari(7,n)
284 iedge = ipari(58,n)
285 flag_removed_node = .false.
286 IF ((nty == 7 .OR. nty == 25) .AND. ipari(63,n) == 2 .AND. iddlevel == 1)THEN
287C--- Initial dimension of REMNODE arrays
288 iremnode = 1
289 nremnode_kind8 = 16*ipari(4,n)
290 IF(nremnode_kind8 > huge(nremnode)) THEN
291 nremnode = huge(nremnode)/2 ! decrease initial value of NREMNODE to fit into integer storage
292 ELSE
293 nremnode = nremnode_kind8
294 END IF
295 CALL upgrade_remnode(ipari(1,n),nremnode,intbuf_tab(n),nty)
296 flag_removed_node = .true.
297 ENDIF
298 IF (nty == 11.AND. ipari(63,n) == 2 .AND. iddlevel == 1)THEN
299C--- Initial dimension of REMNODE arrays
300 iremnode = 1
301 remnode_size = 5*ipari(4,n)
302 CALL upgrade_remnode(ipari(1,n),remnode_size,intbuf_tab(n),nty)
303 ENDIF
304 IF (nty == 25.AND.ipari(58,n) >0 .AND. ipari(63,n) == 2 .AND. iddlevel == 1)THEN
305C--- Initial dimension of REMNODE arrays
306 iremnode_edg = 1
307 remnode_size_edg = 5*ipari(68,n)
308 CALL upgrade_remnode_edg(ipari(1,n),remnode_size_edg,intbuf_tab(n))
309 ENDIF
310 IF((nty==24.OR.nty==25).AND.iddlevel==0.AND.ipari(63,n)>0) THEN
311 IF(intbuf_tab(n)%S_KREMNODE>0) flag_removed_node = .true.
312 IF(nty==25.AND.iedge/=0) flag_removed_node = .true.
313 IF(nty==25.AND.next_inter(2)==0) flag_removed_node = .false.
314 ENDIF
315
316 IF (nty == 2) inter_type2_number=inter_type2_number+1
317 resort = 0
318 IF (nty == 14.OR.nty == 15.OR.nty == 16.OR.nty == 18.OR.nty==0) cycle
319 200 CONTINUE
320
321 IF (i_mem == 2)THEN
322 IF(nty == 11) THEN
323 multimp = max(ipari(23,n)+8,nint(ipari(23,n)*1.75))
324 multimp = max(multimp,ipari(23,n)+2500000/max(1,ipari(18,n)))
325 multimp = max(multimp,intbuf_tab(n)%S_CAND_MAX / max(1,ipari(18,n)))
326 intbuf_tab(n)%S_CAND_MAX = max(multimp*ipari(18,n),intbuf_tab(n)%S_CAND_MAX)
327 ELSE
328 multimp = max(ipari(23,n)+8,nint(ipari(23,n)*1.5))
329 ENDIF
330
331 CALL reset_gap(n,ipari,intbuf_tab(n),frigap)
332 CALL upgrade_multimp(n,multimp,intbuf_tab(n))
333 i_mem = 0
334 resort = 1
335 ENDIF
336
337 jinscr=ipari(10,n)
338 nin=n
339 id=nom_opt(1,nin)
340 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nin),ltitr)
341 nin25 = list_nin25(nin)
342
343 IF(n2d == 0)THEN
344 IF( multi_fvm%IS_INT18_LAW151 ) THEN
345 CALL int18_law151_nsv_shift('+',0,1,multi_fvm,ipari,intbuf_tab,npari,ninter,numnod,opt_int_id=n)
346 ENDIF
347 CALL inint3(
348 . inscr(n)%WA , x , ixs , ixc , pm ,
349 1 geo , ipari , nin , itab , ms ,
350 2 mwa , rwa , ixtg , iwrn , ikine ,
351 3 ixt , ixp , ixr , nelemint , iddlevel ,
352 4 ifiend , ale_connectivity , nsnet , nmnet , igrbric ,
353 5 iwcont , nsnt , nmnt , nsn2t , nmn2t ,
354 6 iwcin2 , knod2els , knod2elc , knod2eltg , nod2els ,
355 7 nod2elc , nod2eltg , igrsurf , ikine1 , ielem21 ,
356 8 sh4tree , sh3tree , ipart , ipartc , iparttg ,
357 9 thk , thk_part , nod2el1d , knod2el1d , ixs10 ,
358 a i_mem , resort , inter_cand , ixs16 , ixs20 ,
359 b id , titr , iremnode , nremnode , iparts ,
360 c kxx , ixx , igeo , intercep , lelx ,
361 d intbuf_tab , fillsol , stack , iworksh , kxig3d ,
362 e ixig3d , tagprt_fric , intbuf_fric_tab , ipartt , ipartp ,
363 f ipartx , ipartr , nsn_multi_connec , t2_add_connec , t2_nb_connec ,
364 g t2_connec , nom_opt , icode , iskew , iremnode_edg ,
365 h multi_fvm%S_APPEND_ARRAY, multi_fvm%X_APPEND , multi_fvm%MASS_APPEND , n2d , flag_removed_node,
366 i nspmd ,inter_type2_number , elem_linked_to_segment, inscr(n)%SINSCR, sicode ,
367 j sitab ,nin25 , flag_elem_inter25 , multi_fvm , iresp )
368 IF( multi_fvm%IS_INT18_LAW151 ) THEN
369 CALL int18_law151_nsv_shift('-',0,1,multi_fvm,ipari,intbuf_tab,npari,ninter,numnod,opt_int_id=n)
370 ENDIF
371
372 IF (i_mem /= 0) GOTO 200
373 ELSE
374 CALL inint2(
375 1 intbuf_tab(n),inscr(n)%WA ,x ,ixq ,inscr(n)%SINSCR,
376 2 pm ,geo ,ipari(1,n),nin ,itab ,
377 3 itabm1 ,numnod ,ikine ,mwa ,ipm ,
378 4 id ,titr ,knod2elq ,nod2elq ,segquadfr ,
379 5 nummat ,ninter ,sitab ,sitabm1 ,sicode ,
380 6 icode)
381 ENDIF
382 ENDDO
383 ! ----------------
384
385 ! ----------------
386 ! update the forbidden nodes for interface type 2 and 24
387 ! thank to remnode algo (remnode for removed node ???)
388 IF (n2d==0.AND.kind_interface==2.AND.nspmd>1) THEN
389 IF(iddlevel==0) THEN
390 flag_output = 0
391 IF (inter_type2_number >0) THEN
392 CALL remn_i2op(1,ninter,ipari,intbuf_tab,itab,nom_opt,nremn,flag_output,skip_type25_edge_2_edge)
393 ENDIF
394 CALL remn_self24(x ,ixs ,ixs10 ,ixs16,ixs20 ,
395 . knod2els,nod2els,ipari ,intbuf_tab ,
396 . itab , nom_opt,nremn, s_nod2els,flag_output)
397 CALL remn_i2_edgop(ipari,intbuf_tab,itab,nremn)
398 CALL ri2_int24p_ini(ipari,intbuf_tab,itab,nom_opt,nremn )
399 ELSE
400 CALL flush_remnode_array(ninter,npari,ipari,intbuf_tab)
401 ENDIF
402 END IF
403 ! ----------------
404
405 ENDDO
406 ! ----------------
407 DEALLOCATE(elem_linked_to_segment)
408C
409C--- IREM_I2 treatment has been removed at end of ININTR2 to take into account
410C---- the compaction of type2 w/ Itetra10=2
411C
412 IF(iwrn/=0) THEN
413 len_filnam = outfile_name_len + rootlen + 6
414 filnam = outfile_name(1:outfile_name_len)//rootnam(1:rootlen)//'.coord'
415 OPEN(unit=iou2,file=filnam(1:len_filnam),status='UNKNOWN',
416 . form='FORMATTED')
417 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
418 . '---5---|---6---|---7---|---8---|'
419 WRITE(iou2,'(A)')'# NEW NODES COORDINATES'
420 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
421 . '---5---|---6---|---7---|---8---|'
422 WRITE(iou2,'(I10,1P3G20.13)')
423 . (itab(i),x(1,i),x(2,i),x(3,i),i=1,numnod)
424 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
425 . '---5---|---6---|---7---|---8---|'
426 WRITE(iou2,'(A)')'# END OF NEW NODES COORDINATES'
427 WRITE(iou2,'(2A)')'#--1---|---2---|---3---|---4---|',
428 . '---5---|---6---|---7---|---8---|'
429 CLOSE(unit=iou2)
430 ENDIF
431
432C =============================================================
433C DETECT INTERFACES WITH HIGH CPU COST
434C - auto-impacting interface on solid
435C - with low stiffness
436C - included in the *main interface*
437C
438C *main interface* : interface that concern a lot of nodes with
439C significantly different velocities between second and main
440 displacement_max = 0.0
441 ns = 0
442 main_interface_size = -1
443 id_main_interface = -1
444 IF(n2d==0)THEN
445 IF((iddlevel==0).AND.(dectyp>=3.AND.dectyp<=6))THEN
446
447 condition(1:ninter) = .false.
448 avg_stiff(1:ninter) = huge(1.0d0)
449 ALLOCATE(tag(numnod))
450 tag(1:numnod) = 0
451 DO n=1,ninter
452 nty=ipari(7,n)
453 IF( nty == 7 ) THEN
454 nmn = ipari(6,n)
455 nsn = ipari(5,n)
456 nrtm = ipari(4,n)
457 inacti = ipari(22,n)
458 ipari_14 = ipari(14,n)
459 is_inter18_and_law151 = .false.
460 IF(inacti == 7)THEN
461 IF(ipari_14 == 151)is_inter18_and_law151 = .true.
462 ENDIF
463 IF(is_inter18_and_law151)cycle
464 ns = 0
465C CALL COUNT_SOLID_NODES(NOD2EL1D,KNOD2EL1D,INTBUF_TAB(N),NMN,NSN,NS)
466C ----------- Count solid nodes
467 DO i = 1,nmn
468 node_id = intbuf_tab(n)%MSR(i)
469 DO j = knod2els(node_id)+1,knod2els(node_id+1)
470 ns = ns +1
471 EXIT
472 ENDDO
473 ENDDO
474C
475 IF (ns > 9*(nmn) / 10) THEN
476 ! Interface concerns mainly solids
477 cpt = 0
478 DO i = 1,nsn
479 tag(intbuf_tab(n)%NSV(i)) = 1
480 ENDDO
481 DO i = 1,nmn
482 IF(tag(intbuf_tab(n)%MSR(i)) == 1) cpt = cpt + 1
483 ENDDO
484 DO i = 1,nsn
485 tag(intbuf_tab(n)%NSV(i)) = 0
486 ENDDO
487 IF( abs(nsn - nmn) < nsn / 50 .AND. abs(nmn - cpt) < nmn/50) THEN
488! Heuristic to find auto-impacting interface
489 condition(n) = .true.
490 avg_stiff(n) = 0.0d0
491 DO i = 1,nrtm
492 avg_stiff(n) = avg_stiff(n) + intbuf_tab(n)%STFM(i)/dble(nrtm)
493 ENDDO
494 IF(avg_stiff(n) == 0) THEN
495 DO i = 1,nsn
496 avg_stiff(n) = avg_stiff(n) + intbuf_tab(n)%STFNS(i)/dble(nsn)
497 ENDDO
498 ENDIF
499 ENDIF
500 ENDIF
501 inacti = ipari(22,n)
502 ipari_14 = ipari(14,n)
503 is_inter18_and_law151 = .false.
504 IF(inacti == 7 .AND. ipari_14 == 151) is_inter18_and_law151 = .true.
505 IF(.NOT. is_inter18_and_law151)THEN
506 CALL c_compute_velocity(v, numnod, intbuf_tab(n)%NSV, nsn, v1, f1)
507 CALL c_compute_velocity(v, numnod, intbuf_tab(n)%MSR, nmn, v2, f2)
508 displacement = (v1(1) - v2(1))**2 + (v1(2) - v2(2))**2 + (v1(3) - v2(3))**2
509 IF(f1 > nsn / 2 .AND. f2 > nmn / 2) THEN
510 IF(displacement > displacement_max / 10.0 .AND. nmn + nsn > main_interface_size) THEN
511 IF( nmn + nsn > numnod / 100 ) THEN
512 ! main interface = interface that has the maximum displacement velocity
513 ! between main and second, and that contains at least 1% of the nodes
514 main_interface_size = nmn + nsn
515 id_main_interface = n
516C CONDITION(N) = .FALSE.
517 displacement_max = displacement
518 ENDIF ! NMN+ NSN
519 ENDIF ! Displacement
520 ENDIF ! f1 & f2
521 ENDIF
522 ENDIF ! NTY
523 ENDDO ! N
524
525 tag(1:numnod) = 0
526 IF(id_main_interface > 0) THEN
527 nsn = ipari(5,id_main_interface)
528 nrtm = ipari(4,id_main_interface)
529 nmn = ipari(6,id_main_interface)
530 main_stiff = 0.0d0
531 DO i = 1,nrtm
532 main_stiff = main_stiff + intbuf_tab(id_main_interface)%STFM(i) / dble(nrtm)
533 ENDDO
534 IF(main_stiff == 0) THEN
535 DO i = 1,nsn
536 main_stiff = main_stiff + intbuf_tab(id_main_interface)%STFNS(i) / dble(nsn)
537 ENDDO
538 ENDIF
539c WRITE(,*) "main stiff=",main_stiff
540 DO i = 1,nsn
541 tag(intbuf_tab(id_main_interface)%NSV(i)) = 1
542 ENDDO
543 DO i = 1,nmn
544 tag(intbuf_tab(id_main_interface)%MSR(i)) = 1
545 ENDDO
546 min_stiff = huge(0.0d0)
547 DO n=1,ninter
548 ipari(69,n) = 0
549 IF(condition(n) .AND. n /= id_main_interface) THEN
550! auto-impacting interface mainly made of solids
551 cpt = 0
552 nmn = ipari(6,n)
553 nsn = ipari(5,n)
554 DO i = 1,nsn
555 IF(tag(intbuf_tab(n)%NSV(i)) == 1) cpt = cpt +1
556 ENDDO
557 IF( cpt > (nsn)/3 ) THEN
558 ! the nodes of this interface are included in the main
559 ! interface
560 min_stiff = min(min_stiff,avg_stiff(n))
561 ipari(69,n) = 1
562C Call routine for interface node weights
563 ENDIF !CPT
564 ENDIF ! CONDITION
565 ENDDO ! NINTER
566 DO n=1,ninter
567 IF(ipari(69,n) == 1) THEN
568 nmn = ipari(6,n)
569 nsn = ipari(5,n)
570 IF(avg_stiff(n) < main_stiff / 10.0) THEN
571 i = 0
572 IF(avg_stiff(n) <= 3.0*min_stiff .AND. avg_stiff(n) < main_stiff / 200.0) i = 1
573 IF(avg_stiff(n) <= 2.0*min_stiff .AND. avg_stiff(n) < main_stiff / 500.0) i = 4
574c WRITE(6,*) "Interface",IPARI(15,N),"weight=",I
575c WRITE(6,*) "Stiff=",min_stiff,avg_stiff(N),main_stiff
576 IF(i > 0) THEN
577 WRITE(iout,*)"INFO: WEIGHT OF INTERFACE",ipari(15,n), "INCREASED"
578 CALL iwcontdd_new(intbuf_tab(n)%NSV,intbuf_tab(n)%MSR,nsn,nmn,iwcont,i)
579 ENDIF
580 ENDIF
581 ENDIF ! CONDITION
582 ENDDO ! NINTER
583
584 ENDIF ! main interface
585
586 DEALLOCATE(tag)
587 ENDIF
588 ENDIF ! N2D
589
590C
591 DEALLOCATE(t2_add_connec,t2_connec,ikine1)
592 DEALLOCATE(itabm1)
593C
594 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
flush_remnode_array
subroutine flush_remnode_array(ninter, npari, ipari, intbuf_tab)
Definition flush_remnode_array.F:30
iwcontdd_new
subroutine iwcontdd_new(nsv, msr, nsn, nmn, iwcont, cost)
Definition grid2mat.F:2974
remn_i2_edgop
subroutine remn_i2_edgop(ipari, intbuf_tab, itab, nremov)
Definition i7remnode.F:1420
remn_i2op
subroutine remn_i2op(lower_bound, upper_bound, ipari, intbuf_tab, itab, nom_opt, nremov, iddlevel, skip_type25_edge_2_edge)
Definition i7remnode.F:675
ri2_int24p_ini
subroutine ri2_int24p_ini(ipari, intbuf_tab, itab, nom_opt, nremov)
Definition i7remnode.F:1741
inint2
subroutine inint2(intbuf_tab, inscr, x, ixq, sinscr, pm, geo, ipari, nint, itab, itabm1, numnod, ikine, mwa, ipm, id, titr, knod2elq, nod2elq, segquadfr, nummat, ninter, sitab, sitabm1, sicode, icode)
Definition inint2.F:50
inint3
subroutine inint3(inscr, x, ixs, ixc, pm, geo, ipari, nin, itab, ms, mwa, rwa, ixtg, iwrn, ikine, ixt, ixp, ixr, nelemint, iddlevel, ifiend, ale_connectivity, nsnet, nmnet, igrbric, iwcont, nsnt, nmnt, nsn2t, nmn2t, iwcin2, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, igrsurf, ikine1, ielem21, sh4tree, sh3tree, ipart, ipartc, iparttg, thk, thk_part, nod2el1d, knod2el1d, ixs10, i_mem, resort, inter_cand, ixs16, ixs20, id, titr, iremnode, nremnode, iparts, kxx, ixx, igeo, intercep, lelx, intbuf_tab, fillsol, stack, iworksh, kxig3d, ixig3d, tagprt_fric, intbuf_fric_tab, ipartt, ipartp, ipartx, ipartr, nsn_multi_connec, t2_add_connec, t2_nb_connec, t2_connec, nom_opt, icode, iskew, iremnode_edg, s_append_array, x_append, mass_append, n2d, flag_removed_node, nspmd, inter_type2_number, elem_linked_to_segment, sinscr, sicode, sitab, nin25, flag_elem_inter25, multi_fvm, iresp)
Definition inint3.F:147
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
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
front_mod
Definition front_mod.F:84
groupdef_mod
Definition groupdef_mod.F:668
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
int18_law151_nsv_shift_mod
Definition int18_law151_nsv_shift.F:30
int18_law151_nsv_shift_mod::int18_law151_nsv_shift
subroutine int18_law151_nsv_shift(mode, itask, nthread, multi_fvm, ipari, intbuf_tab, npari, ninter, numnod, opt_int_id)
Definition int18_law151_nsv_shift.F:49
intbufscratch_mod
Definition intbufscratch_mod.F:33
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
stack_mod
Definition stack_mod.F:75
remn_self24
subroutine remn_self24(x, ixs, ixs10, ixs16, ixs20, knod2els, nod2els, ipari, intbuf_tab, itab, nom_opt, nremov, s_nod2els, iddlevel)
Definition remn_self24.F:40
reset_gap
subroutine reset_gap(ni, ipari, intbuf_tab, frigap)
Definition reset_gap.F:30
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
stack_mod::stack_ply
Definition stack_mod.F:85
upgrade_multimp
subroutine upgrade_multimp(ni, multimp_parameter, intbuf_tab)
Definition upgrade_multimp.F:48
upgrade_remnode_edg
subroutine upgrade_remnode_edg(ipari, nremnode, intbuf_tab)
Definition upgrade_remnode.F:225
upgrade_remnode
subroutine upgrade_remnode(ipari, nremnode, intbuf_tab, nty)
Definition upgrade_remnode.F:33