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