OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r2r_group.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "sphcom.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine r2r_group (ngrou, innod, flag, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartsp, ixs10, ixs20, ixs16, kk, buf_nod, ixr_kj, inom_opt, ipart_l, iad, nale_r2r, flg_r2r_err, pm_stack, iworksh, igrbric2, igrquad2, igrsh4n2, igrsh3n2, igrtruss2, igrbeam2, igrspring2, igrnod2, igrsurf2, igrslin2, lsubmodel, ale_euler, igeo_, nloc_dmg, detonators, nsensor, seatbelt_shell_to_spring, nb_seatbelt_shells, mat_param)

Function/Subroutine Documentation

◆ r2r_group()

subroutine r2r_group ( integer ngrou,
integer innod,
integer flag,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) ipartg,
integer, dimension(*) ipartsp,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer kk,
integer, dimension(*) buf_nod,
integer, dimension(*) ixr_kj,
integer, dimension(*) inom_opt,
integer, dimension(*) ipart_l,
integer iad,
integer, dimension(*) nale_r2r,
integer flg_r2r_err,
pm_stack,
integer, dimension(*) iworksh,
type (group_), dimension(ngrbric) igrbric2,
type (group_), dimension(ngrquad) igrquad2,
type (group_), dimension(ngrshel) igrsh4n2,
type (group_), dimension(ngrsh3n) igrsh3n2,
type (group_), dimension(ngrtrus) igrtruss2,
type (group_), dimension(ngrbeam) igrbeam2,
type (group_), dimension(ngrspri) igrspring2,
type (group_), dimension(ngrou) igrnod2,
type (surf_), dimension(nsurf) igrsurf2,
type (surf_), dimension(nslin) igrslin2,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer ale_euler,
integer, dimension(npropgi,numgeo), intent(in) igeo_,
type (nlocal_str_), intent(in) nloc_dmg,
type (detonators_struct_), intent(in), target detonators,
integer, intent(in) nsensor,
integer, dimension(numelc,2), intent(in) seatbelt_shell_to_spring,
integer, intent(in) nb_seatbelt_shells,
type (matparam_struct_), dimension(nummat), intent(in) mat_param )

Definition at line 49 of file r2r_group.F.

59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE my_alloc_mod
63 USE restmod
64 USE r2r_mod
65 USE message_mod
66 USE groupdef_mod
67 USE group_mod
68 USE inoutfile_mod
69 USE submodel_mod
70 USE inivol_def_mod , ONLY : num_inivol
71 USE nlocal_reg_mod
72 USE detonators_mod
73 USE matparam_def_mod
74 USE names_and_titles_mod , ONLY : nchartitle
75 USE reader_old_mod , ONLY : kinter, nslash
76C-----------------------------------------------
77C I m p l i c i t T y p e s
78C-----------------------------------------------
79#include "implicit_f.inc"
80C-----------------------------------------------
81C A r g u m e n t s
82C-----------------------------------------------
83 INTEGER,INTENT(IN) :: IGEO_(NPROPGI,NUMGEO)
84C-----------------------------------------------
85C C o m m o n B l o c k s
86C-----------------------------------------------
87#include "com01_c.inc"
88#include "com04_c.inc"
89#include "units_c.inc"
90#include "scr17_c.inc"
91#include "param_c.inc"
92#include "sphcom.inc"
93#include "r2r_c.inc"
94C-----------------------------------------------
95C D u m m y A r g u m e n t s
96C-----------------------------------------------
97 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
98 INTEGER ,INTENT(IN) :: NSENSOR
99 INTEGER NGROU,
100 . BUF_NOD(*),INNOD,FLAG,KK,
101 . IPARTS(*),IXS10(6,*),IXS20(12,*),
102 . IXS16(8,*),IPARTQ(*),IPARTSP(*),
103 . IPARTC(*),IPARTT(*),IPARTP(*),IPARTR(*),
104 . IPARTG(*),IXR_KJ(*),INOM_OPT(*),IPART_L(*),IAD,
105 . NALE_R2R(*),FLG_R2R_ERR,IWORKSH(*),ALE_EULER
106 INTEGER ,INTENT(IN) :: NB_SEATBELT_SHELLS
107 INTEGER ,INTENT(IN) :: SEATBELT_SHELL_TO_SPRING(NUMELC,2)
108 my_real :: pm_stack(*)
109 TYPE (NLOCAL_STR_) ,INTENT(IN) :: NLOC_DMG
110 TYPE (DETONATORS_STRUCT_),TARGET,INTENT(IN) :: DETONATORS
111 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
112C-----------------------------------------------
113! TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD2
114 TYPE (GROUP_) , DIMENSION(NGROU) :: IGRNOD2
115 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC2
116 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD2
117 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N2
118 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N2
119 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS2
120 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM2
121 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING2
122 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF2
123 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN2
124C-----------------------------------------------
125C L o c a l V a r i a b l e s
126C-----------------------------------------------
127 INTEGER STAT,I,J,IGR,IGRS,N,NUM,K,ADD,COMPT,IGS,IPID_L
128 INTEGER ID_TEMP(NB_PART_SUB),NSUBDOM_LOC,P,TMP_PART(NPART)
129 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IGROUP_TEMP2
130 INTEGER N_LNK_C,NI,GRM,GRS,MAIN,IGU,NUL,IAD_TMP,COMPT_T2
131 INTEGER MODIF,NINTER_PREC,FAC,IO_ERR,NUM_KJ,NSPCONDN,NSPHION,NN
132 INTEGER MEMTR(NUMNOD),FLG_SPH,COUNT,NEW_NSLASH_INT,NEW_HM_NINTER,NEW_NINTSUB,NEW_NINIVOL
133 CHARACTER(LEN=NCHARTITLE) :: TITR
134 CHARACTER NAME*100
135 INTEGER NGRNOD2,NGRBRIC2,NGRQUAD2,NGRSHEL2,NGRSH3N2,NGRTRUS2,NGRBEAM2,NGRSPRI2,LENGRN,ITITLE(LTITR)
136 CHARACTER(LEN=NCHARTITLE) :: NEW_TITLE(NGROU+10*NSUBDOM)
137 INTEGER, DIMENSION(:), ALLOCATABLE :: IGROUP_TEMP2_BUF,TAG_NLOCAL
138 INTEGER :: LEN_TMP_NAME
139 CHARACTER(len=4096) :: TMP_NAME
140C-----------------------------------------------
141 n_lnk_c = 0
142 tmp_part(:)= 0
143 modif = 1
144 innod = 0
145C----- Storage of IGRN in IGRN Temp------------------------------C
146 lengrn = 9
147 IF (flag == 1) THEN
148 ALLOCATE(igroup_temp2(10,ngrou+10*nsubdom))
149 igroup_temp2 = 0
150 count = 0
151 DO i=1,ngrou
152 count = count + igrnod2(i)%NENTITY
153 ENDDO
154 IF (count > 0) THEN
155 ALLOCATE(igroup_temp2_buf(count))
156 igroup_temp2_buf(:) = 0
157 ENDIF
158 iad_tmp = 1
159!
160 DO i=1,ngrou
161 igroup_temp2(1,i) = igrnod2(i)%ID ! IGRN(1,*)
162 igroup_temp2(2,i) = igrnod2(i)%NENTITY ! IGRN(2,*)
163 igroup_temp2(3,i) = igrnod2(i)%GRTYPE ! igrn(4,*)
164 igroup_temp2(4,i) = igrnod2(i)%SORTED ! IGRN(5,*)
165 igroup_temp2(5,i) = igrnod2(i)%GRPGRP ! IGRN(6,*)
166 igroup_temp2(6,i) = igrnod2(i)%LEVEL ! IGRN(7,*)
167 new_title(i) = igrnod2(i)%TITLE ! IGRN(11,*)
168 igroup_temp2(8,i) = igrnod2(i)%R2R_ALL ! IGRN(8,*)
169 igroup_temp2(9,i) = igrnod2(i)%R2R_SHARE ! IGRN(9,*)
170 igroup_temp2(7,i) = iad_tmp
171 DO j=1,igrnod2(i)%NENTITY
172 igroup_temp2_buf(iad_tmp) = igrnod2(i)%ENTITY(j)
173 iad_tmp = iad_tmp + 1
174 ENDDO
175 ENDDO
176 ENDIF
177C--------------------------------------------------------------------C
178C------Creation of groups of nodes of multidomains interface---------C
179C--------------------------------------------------------------------C
180!
181 ngrnod2 = ngrnod
182 ngrbric2 = ngrbric
183 ngrquad2 = ngrquad
184 ngrshel2 = ngrshel
185 ngrsh3n2 = ngrsh3n
186 ngrtrus2 = ngrtrus
187 ngrbeam2 = ngrbeam
188 ngrspri2 = ngrspri
189!
190 IF (flag == 1) THEN
191 num = 1
192 igs = ngrou+1
193 DO i=1,ngrou
194 IF (num<=igrnod2(i)%ID) num=igrnod2(i)%ID+1
195 END DO
196 ENDIF
197C--------------------------------------------------------------------C
198 IF (ipid==0) nsubdom = 1
199 nsubdom_loc = nsubdom
200 DO p=1,nsubdom_loc
201C-----2 pass : pass 1 - contact nodes / passe 2 - connection nodes
202 n = p
203 IF (ipid==0) n = iddom
204 compt = 0
205C--------------------------------------------------------------------C
206C---------------FLAG = 0 --> tag of nodes and counting --------------C
207C--------------------------------------------------------------------C
208 IF (flag==0) THEN
209C---------------Reset of out file + printout of new heading ---------C
210 ipid_l = ipid
211 IF (flg_swale==1) THEN
212 IF (ipid==0) ipid_l = 1
213 IF (ipid/=0) ipid_l = 0
214 ENDIF
215 IF (ipid_l==0) THEN
216 CLOSE(unit=iout, status='DELETE',iostat=io_err)
217
218 tmp_name=outfile_name(1:outfile_name_len)//r2r_filnam(1:len_trim(r2r_filnam))
219 len_tmp_name = outfile_name_len+len_trim(r2r_filnam)
220 OPEN(unit=iout,file=tmp_name(1:len_tmp_name),
221 . access='SEQUENTIAL',
222 . form='FORMATTED',status='UNKNOWN')
223 name = "SUBDOMAIN "//r2r_filnam(1:(len_trim(r2r_filnam)-9))
224 WRITE (iout,'(A)') ''
225 CALL printcenter(" ",0,iout,1)
226 CALL printcenter(" ",0,iout,2)
227 CALL printcenter(name,len_trim(name),iout,2)
228 CALL printcenter(" ",0,iout,2)
229 CALL printcenter(" ",0,iout,1)
230 ENDIF
231C---------------Allocation of arrays for tag of elements--------------C
232 ALLOCATE(tag_elc(numelc+npart),tag_els(numels+npart))
233 ALLOCATE(tag_elg(numeltg+npart),tag_elsp(numsph+npart))
234 ALLOCATE(tag_elr(numelr+npart),tag_elt(numelt+npart))
235 ALLOCATE(tag_elp(numelp+npart),tag_elq(numelq+npart))
236 tag_els(:)=0
237 tag_elc(:)=0
238 tag_elg(:)=0
239 tag_elt(:)=0
240 tag_elp(:)=0
241 tag_elr(:)=0
242 tag_elq(:)=0
243 tag_elsp(:)=0
244C---------------Tag of Parts-------------------------------------------C
245 DO k=1,npart
246 tagno(k)=0
247C ---> TAGNO(K)=-1 => PART K belongs to an already treated subdomain---
248 IF(tmp_part(k)==-1) tagno(k)=-1
249 ENDDO
250 add = isubdom(3,n)
251 DO k=1,npart
252 DO i=1,isubdom(1,n)
253 IF(k == isubdom_part(i+add))THEN
254 tagno(k)=1
255 tmp_part(k)=-1
256 ENDIF
257 ENDDO
258 END DO
259C----------------Full domain - inversion of part selection-------------C
260 IF (iddom == 0) THEN
261 DO k=1,npart
262 IF(tagno(k)==1) THEN
263 tagno(k)=0
264 ELSEIF(tagno(k)==0) THEN
265 tagno(k)=1
266 ENDIF
267 ENDDO
268 ENDIF
269C---------------> TAG OF PARTS : ----------------------------------
270C---------------> TAGNO(K) = -1 -> Part of already treated subdmain
271C---------------> TAGNO(K) = 0 -> Internal part of subdomain
272C---------------> TAGNO(K) = 1 -> External part of subdomain
273
274C---------------> TAG OF NODES : ----------------------------------
275C---------------> TAGNO(K) = -1 -> external node
276C---------------> TAGNO(K) = 0 -> free node (not attached to any domain)
277C---------------> TAGNO(K) = 1 -> internal node
278C---------------> TAGNO(K) = 2 -> coupled node
279C---------------> TAGNO(K) = 3 -> coupled node -> main node of RBODY
280C---------------> TAGNO(K) = 4 -> coupled node for contacts
281C---------------Detag of already treated nodes----------------------C
282 CALL tagnods_r2r(ixs,ixs10,ixs20,ixs16,iparts,tagno,-1,n)
283 CALL tagnod_r2r(ixq,nixq,2,5,numelq,ipartq,tagno,npart,-1,n)
284 CALL tagnod_r2r(ixc,nixc,2,5,numelc,ipartc,tagno,npart,-1,n)
285 CALL tagnod_r2r(ixt,nixt,2,3,numelt,ipartt,tagno,npart,-1,n)
286 CALL tagnod_r2r(ixp,nixp,2,4,numelp,ipartp,tagno,npart,-1,n)
287 CALL tagnod_r2r(ixr,nixr,2,3,numelr,ipartr,tagno,npart,-1,n)
288 CALL tagnod_r2r(ixtg,nixtg,2,4,numeltg,ipartg,tagno,npart,-1,n)
289 CALL tagnod_r2r(kxsp,nisp,3,3,numsph,ipartsp,tagno,npart,-1,n)
290C---------------Tag of nodes -> pass 1------------------------------C
291 CALL tagnods_r2r(ixs,ixs10,ixs20,ixs16,iparts,tagno,0,n)
292 CALL tagnod_r2r(ixq,nixq,2,5,numelq,ipartq,tagno,npart,0,n)
293 CALL tagnod_r2r(ixc,nixc,2,5,numelc,ipartc,tagno,npart,0,n)
294 CALL tagnod_r2r(ixt,nixt,2,3,numelt,ipartt,tagno,npart,0,n)
295 CALL tagnod_r2r(ixp,nixp,2,3,numelp,ipartp,tagno,npart,0,n)
296 CALL tagnod_r2r(ixr,nixr,2,3,numelr,ipartr,tagno,npart,0,n)
297 CALL tagnod_r2r(ixtg,nixtg,2,4,numeltg,ipartg,tagno,npart,0,n)
298 CALL tagnod_r2r(kxsp,nisp,3,3,numsph,ipartsp,tagno,npart,0,n)
299C---------------Tag of nodes -> pass 2-------------------------------C
300 CALL tagnods_r2r(ixs,ixs10,ixs20,ixs16,iparts,tagno,1,n)
301 CALL tagnod_r2r(ixq,nixq,2,5,numelq,ipartq,tagno,npart,1,n)
302 CALL tagnod_r2r(ixc,nixc,2,5,numelc,ipartc,tagno,npart,1,n)
303 CALL tagnod_r2r(ixt,nixt,2,3,numelt,ipartt,tagno,npart,1,n)
304 CALL tagnod_r2r(ixp,nixp,2,3,numelp,ipartp,tagno,npart,1,n)
305 CALL tagnod_r2r(ixr,nixr,2,3,numelr,ipartr,tagno,npart,1,n)
306 CALL tagnod_r2r(ixtg,nixtg,2,4,numeltg,ipartg,tagno,npart,1,n)
307 CALL tagnod_r2r(kxsp,nisp,3,3,numsph,ipartsp,tagno,npart,1,n)
308C---------------Tag of 3rd nodes of beams/springs -> pass 3----------C
309 CALL tagnod_r2r(ixp,nixp,4,4,numelp,ipartp,tagno,npart,3,n)
310 CALL tagnod_r2r(ixr,nixr,4,4,numelr,ipartr,tagno,npart,3,n)
311C---------------Tag of additional nodes for kjoints-- --------------C
312 CALL tagnod_r2r(ixr_kj,5,1,3,numelr,ipartr,tagno,npart,4,n)
313C---------------Tag of specific nodes -> Skew,Frames-----------------C
314 IF (p==nsubdom_loc) CALL tagnod_r2r_s(tagno)
315C---------------Storage of initial tag of nodes----------------------C
316 DO i=1,numnod
317 tagno(npart+numnod+i) = tagno(npart+i)
318 END DO
319C--------------------------------------------------------------------C
320C////////////////////////////////////////////////////////////////////C
321C--------------------------------------------------------------------C
322 DO WHILE ((modif>0).AND.(compt<80))
323 modif = 0
324C---------------Prereading of options for tag of nodes---------------C
325 IF (p==nsubdom_loc) THEN
326 CALL r2r_prelec(iparts,
327 2 ipartc,ipartg,ipartt,ipartp,ipartr,ipartsp,compt_t2,
328 3 modif,compt,inom_opt,nspcondn,nsphion,ipart_l,memtr,
329 4 pm_stack ,iworksh ,igrnod ,igrsurf ,igrslin ,
330 5 igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss,
331 6 igrbeam ,igrspring ,new_nslash_int,lsubmodel,new_hm_ninter,
332 7 new_nintsub,new_ninivol,ixs10,ixs20,ixs16,
333 8 detonators,nsensor,seatbelt_shell_to_spring,nb_seatbelt_shells)
334 ENDIF
335C---------------Tag of nodes of pretaged elements ( for TYPE2)-------C
336 IF (compt_t2>0) THEN
337 CALL tagnods_r2r(ixs,ixs10,ixs20,ixs16,tag_els,tagno,2,1)
338 CALL tagnod_r2r(ixc,nixc,2,5,numelc,tag_elc,tagno,npart,2,1)
339 CALL tagnod_r2r(ixtg,nixtg,2,4,numeltg,tag_elg,tagno,npart,2,1)
340 CALL tagnod_r2r(ixt,nixt,2,3,numelt,tag_elt,tagno,npart,2,1)
341 CALL tagnod_r2r(ixp,nixp,2,4,numelp,tag_elp,tagno,npart,2,1)
342 ENDIF
343 compt = compt+1
344 END DO ! DO WHILE
345C---------------Tag of nodes ALE/lagrange ---------------------------C
346 IF (iale>0) THEN
347 CALL ale_check_lag(nale_r2r,ixs,ixq,ixc,ixt,ixtg,pm,itab,nale_r2r,0,igeo_)
348 ENDIF
349C---------------Check of FLG_FSI ------------------------------------C
350 IF (iale+ieuler>0) THEN
351 CALL chk_flg_fsi(ixs,pm,iparts,ale_euler,igeo_)
352 ENDIF
353C---------------Error message infinite loop -------------------------C
354 IF (compt>=80) THEN
355 CALL ancmsg(msgid=972,
356 . msgtype=msgerror,
357 . anmode=aninfo)
358 END IF
359C--------------------------------------------------------------------C
360C////////////////////////////////////////////////////////////////////C
361C--------------------------------------------------------------------C
362C---------------Update of number of remaining options----------------C
363 nrbody = new_nrby
364 nrbykin = new_nrbykin
365 njoint = new_njoint
366 ninter_prec = ninter
367 hm_ninter = new_hm_ninter
368 ninter = new_hm_ninter + new_ninter - new_nintsub
369 nslash(kinter) = new_nslash_int
370 nintsub = new_nintsub
371 num_inivol = new_ninivol
372C
373 nlink = new_nlink
374 nrbe3 = new_nrbe3
375 nrbe2 = new_nrbe2
376 ngjoint = new_ngjoint
377 nummpc = new_nummpc
378 nspcond = nspcondn
379 nsphio = nsphion
380C---------------Determination of flag for coupled sph particles------C
381 flg_sph = 0
382 DO j=1,numsph
383 IF (tagno(kxsp(nisp*(j-1)+3)+npart)>1) flg_sph = 1
384 END DO
385C---------------Counting of remaining nodes--------------------------C
386 compt = 0
387 DO j=1,numnod
388 IF (tagno(j+npart)>1) innod = innod+1
389 ENDDO
390C---------------Warnings for size of interfaces ---------------------C
391 IF (innod==0) THEN
392 CALL ancmsg(msgid=839,
393 . msgtype=msgerror,
394 . anmode=aninfo,
395 . c1="CONNECTIONS FOUND",
396 . c2="FOR DOMAIN",
397 . i1=isubdom(1,p))
398 ELSE
399C-- For SPH big multidomains interfaces are alloxed -> no error message only a warning
400 IF ((flg_sph==1).OR.(flg_fsi==1)) r2r_flag_err_off = 1
401C
402 fac = (100*innod) / numnod
403 IF (((fac>20).AND.(fac<50)).OR.((r2r_flag_err_off==1).AND.(fac>50))) THEN
404 CALL ancmsg(msgid=859,
405 . msgtype=msgwarning,
406 . anmode=aninfo_blind_1,
407 . i1=innod,
408 . i2=fac)
409 ELSEIF (fac>50) THEN
410 flg_r2r_err = 1
411 CALL ancmsg(msgid=1075,
412 . msgtype=msgerror,
413 . anmode=aninfo_blind_1,
414 . i1=innod,
415 . i2=fac)
416 ENDIF
417 ENDIF
418C---------------Warnings for splitted contact interfaces ------------C
419 IF (tagint_warn(1)>0) THEN
420 CALL ancmsg(msgid=842,
421 . msgtype=msgwarning,
422 . anmode=aninfo_blind_1)
423 WRITE(iout,1301)
424 WRITE(iout,1302) (tagint_warn(1+j),j=1,tagint_warn(1))
425 ENDIF
426C--------------------------------------------------------------------C
427 ELSE
428C--------------------------------------------------------------------C
429C---------------FLAG = 1 --> Creation of groups and links------------C
430C--------------------------------------------------------------------C
431 innod = 0
432 nn = 4
433C
434C---------------Tag of nodes with nlocal dof-------------------------C
435 IF (nloc_dmg%IMOD > 0) THEN
436 nn = 5
437 CALL my_alloc(tag_nlocal,numnod)
438 tag_nlocal(1:numnod) = 0
439 CALL tagnod_r2r_nl(ixc,ixtg,ixs,ixs10,ixs20,
440 . ixs16,tag_nlocal,mat_param)
441 ENDIF
442C
443 DO k=1,nn
444 compt = 0
445 iad_tmp = iad
446C-----------Storage inside buffer------------------------------------C
447 IF (k < 5) THEN
448 DO j=1,numnod
449 IF (tagno(j+npart)==(k+n)) THEN
450 buf_nod(iad)=j
451 iad=iad+1
452 compt = compt+1
453 ENDIF
454 ENDDO
455 ELSE
456C-----------Nodes in link type 4 + nlocal dof -> additional link-----C
457C-----------Node coupled only if nl material on both sides ----------C
458 DO j=1,numnod
459 IF ((tag_nlocal(j)==1).AND.(tagno(j+npart+numnod) == n+1)) THEN
460 buf_nod(iad)=j
461 iad=iad+1
462 compt = compt+1
463 ENDIF
464 ENDDO
465 ENDIF
466C
467 innod = innod + compt
468 IF (compt>0) THEN
469C---------------Creation of new GRNOD + LINK ------------------------C
470 IF (k == 1) THEN
471 titr="MULTIDOMAINS INTERFACE TYPE CONNECTION "
472 ELSEIF (k == 2) THEN
473 titr="MULTIDOMAINS INTERFACE TYPE RBODY CONNECTION "
474 ELSEIF (k == 4) THEN
475 titr="MULTIDOMAINS INTERFACE TYPE KINEMATIC CONDITION"
476 ELSEIF (k == 5) THEN
477 titr="MULTIDOMAINS INTERFACE TYPE NON LOCAL"
478 ELSE
479 titr="MULTIDOMAINS INTERFACE TYPE CONTACT "
480 ENDIF
481!---
482 igroup_temp2(1,igs)= num
483 igroup_temp2(2,igs)= compt
484 igroup_temp2(3,igs)= iad_tmp
485 igroup_temp2(10,igs)= -1 ! temporary tag new group
486 new_title(igs) = titr
487!---
488C---------------Creation of new LINK---------------------------------C
489 CALL new_link(num,n,k)
490C---------------Incrementation of Variables for future GRNOD---------C
491 num = num+1
492 igs = igs+1
493 IF (compt>0) n_lnk_c = n_lnk_c+1
494 ENDIF
495 END DO
496 IF (innod==0) THEN
497 IF (ipid/=0) THEN
498 ENDIF
499 CALL ancmsg(msgid=839,
500 . msgtype=msgerror,
501 . anmode=aninfo,
502 . c1="CONNECTIONS FOUND",
503 . c2="FOR DOMAIN",
504 . i1=isubdom(1,p))
505 ENDIF
506c
507 IF (nloc_dmg%IMOD > 0) THEN
508 DEALLOCATE(tag_nlocal)
509 ENDIF
510 ENDIF
511 END DO
512C--------------------------------------------------------------------C
513C----- Recopy of other groups in IGROUP_TEMP-------------------------C
514C--------------------------------------------------------------------C
515C----- Transfer of Igroup_temp in IGRN-------------------------------C
516C--------------------------------------------------------------------C
517 IF (flag == 1) THEN
518 DO i=1,ngrnod
519 DEALLOCATE(igrnod(i)%ENTITY)
520 ENDDO
521 DEALLOCATE(igrnod)
522 ALLOCATE(igrnod(ngrnod+n_lnk_c))
523 ngrnod = ngrnod+n_lnk_c
524!
525 DO i=1,ngrnod
526 ALLOCATE(igrnod(i)%ENTITY(igroup_temp2(2,i)))
527 igrnod(i)%ENTITY(1:igroup_temp2(2,i)) = 0
528!
529 igrnod(i)%ID = igroup_temp2(1,i) ! IGRN(1,*)
530 igrnod(i)%NENTITY = igroup_temp2(2,i) ! IGRN(2,*)
531 igrnod(i)%GRTYPE = igroup_temp2(3,i) ! IGRN(4,*)
532 igrnod(i)%SORTED = igroup_temp2(4,i) ! IGRN(5,*)
533 igrnod(i)%GRPGRP = igroup_temp2(5,i) ! IGRN(6,*)
534 igrnod(i)%LEVEL = igroup_temp2(6,i) ! IGRN(7,*)
535 igrnod(i)%TITLE = new_title(i) ! IGRN(11,*)
536 igrnod(i)%R2R_ALL = igroup_temp2(8,i) ! IGRN(8,*)
537 igrnod(i)%R2R_SHARE = igroup_temp2(9,i) ! IGRN(9,*)
538!
539 IF (igroup_temp2(10,i) == -1) THEN
540 iad_tmp = igroup_temp2(3,i)
541 DO j=1,igroup_temp2(2,i)
542! "BUF_NOD" --> temporary array for shared boundary
543 igrnod(i)%ENTITY(j) = buf_nod(iad_tmp+j-1)
544 ENDDO
545 ELSE
546 iad_tmp = igroup_temp2(7,i)
547 DO j=1,igroup_temp2(2,i)
548 igrnod(i)%ENTITY(j) = igroup_temp2_buf(iad_tmp+j-1)
549 ENDDO
550 ENDIF
551!
552 END DO ! DO I=1,NGRNOD
553 ENDIF ! IF (FLAG == 1)
554C--------------------------------------------------------------------C
555C----- Creation of file "_0000.r2r"----------------------------------C
556C--------------------------------------------------------------------C
557 IF (flag == 1) THEN
558 IF (ipid/=0) THEN
559 WRITE(istdo,'(A)')' .. MULTIDOMAINS INPUT FILE GENERATION'
560 CALL r2r_input(iexlnk)
561 ENDIF
562 ENDIF
563C--------------------------------------------------------------------C
564C--------------------------------------------------------------------C
565C--------------------------------------------------------------------C
566 IF (flag == 1) DEALLOCATE(igroup_temp2)
567 IF (flag == 1) THEN
568 IF (ALLOCATED(igroup_temp2_buf))DEALLOCATE(igroup_temp2_buf)
569 ENDIF
570 RETURN
571C--------------------------------------------------------------------C
5721301 FORMAT( 1x,'list of splitted contact interfaces : ')
5731302 FORMAT( 1X,10I9)
574
ale_check_lag
subroutine ale_check_lag(nale, ixs, ixq, ixc, ixt, ixtg, pm, itab, nale_r2r, flag_r2r, igeo)
Definition ale_check_lag.F:34
my_real
#define my_real
Definition cppsort.cpp:32
detonators_mod
Definition detonators_mod.F:79
group_mod
Definition group_mod.F:31
group_mod::igrsh4n
type(group_), dimension(:), allocatable, target igrsh4n
Definition group_mod.F:38
group_mod::igrquad
type(group_), dimension(:), allocatable, target igrquad
Definition group_mod.F:37
group_mod::igrbeam
type(group_), dimension(:), allocatable, target igrbeam
Definition group_mod.F:41
group_mod::igrsurf
type(surf_), dimension(:), allocatable, target igrsurf
Definition group_mod.F:46
group_mod::igrtruss
type(group_), dimension(:), allocatable, target igrtruss
Definition group_mod.F:40
group_mod::igrsh3n
type(group_), dimension(:), allocatable, target igrsh3n
Definition group_mod.F:39
group_mod::igrspring
type(group_), dimension(:), allocatable, target igrspring
Definition group_mod.F:42
group_mod::igrbric
type(group_), dimension(:), allocatable, target igrbric
Definition group_mod.F:36
group_mod::igrslin
type(surf_), dimension(:), allocatable, target igrslin
Definition group_mod.F:47
group_mod::igrnod
type(group_), dimension(:), allocatable, target igrnod
Definition group_mod.F:35
groupdef_mod
Definition groupdef_mod.F:662
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
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
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
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_els
integer, dimension(:), allocatable tag_els
Definition r2r_mod.F:133
r2r_mod::tag_elg
integer, dimension(:), allocatable tag_elg
Definition r2r_mod.F:135
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::tag_elq
integer, dimension(:), allocatable tag_elq
Definition r2r_mod.F:135
r2r_mod::tag_elc
integer, dimension(:), allocatable tag_elc
Definition r2r_mod.F:133
r2r_mod::tag_elr
integer, dimension(:), allocatable tag_elr
Definition r2r_mod.F:134
r2r_mod::tag_elt
integer, dimension(:), allocatable tag_elt
Definition r2r_mod.F:134
r2r_mod::isubdom_part
integer, dimension(:), allocatable isubdom_part
Definition r2r_mod.F:131
r2r_mod::tagint_warn
integer, dimension(:), allocatable tagint_warn
Definition r2r_mod.F:137
r2r_mod::tag_elp
integer, dimension(:), allocatable tag_elp
Definition r2r_mod.F:133
r2r_mod::isubdom
integer, dimension(:,:), allocatable isubdom
Definition r2r_mod.F:144
r2r_mod::tag_elsp
integer, dimension(:), allocatable tag_elsp
Definition r2r_mod.F:142
restmod::ixs
integer, dimension(:), allocatable, target ixs
Definition restart_mod.F:60
restmod::ixt
integer, dimension(:), allocatable ixt
Definition restart_mod.F:60
restmod::ixr
integer, dimension(:), allocatable ixr
Definition restart_mod.F:60
restmod::iexlnk
integer, dimension(:), allocatable iexlnk
Definition restart_mod.F:60
restmod::ixtg
integer, dimension(:), allocatable, target ixtg
Definition restart_mod.F:60
restmod::kxsp
integer, dimension(:), allocatable kxsp
Definition restart_mod.F:60
restmod::itab
integer, dimension(:), allocatable itab
Definition restart_mod.F:60
restmod::ixp
integer, dimension(:), allocatable ixp
Definition restart_mod.F:60
restmod::ixq
integer, dimension(:), allocatable ixq
Definition restart_mod.F:60
restmod::nloc_dmg
type(nlocal_str_) nloc_dmg
Definition restart_mod.F:156
restmod::ixc
integer, dimension(:), allocatable ixc
Definition restart_mod.F:60
submodel_mod
Definition submodel_mod.F:712
new_link
subroutine new_link(num, n, k)
Definition new_link.F:32
r2r_input
subroutine r2r_input(iexter)
Definition r2r_input.F:33
r2r_prelec
subroutine r2r_prelec(iparts, ipartc, ipartg, ipartt, ipartp, ipartr, ipartsp, compt_t2, modif, passe, inom_opt, nspcondn, nsphion, ipart_l, memtr, pm_stack, iworksh, igrnod, igrsurf, igrslin, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, new_nslash_int, lsubmodel, new_hm_ninter, new_nintsub, new_ninivol, ixs10, ixs20, ixs16, detonators, nsensor, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition r2r_prelec.F:62
chk_flg_fsi
subroutine chk_flg_fsi(ixs, pm, iparts, ale_euler, igeo)
Definition routines_r2r.F:705
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
printcenter
subroutine printcenter(array, arrlen, linout, flag)
Definition radioss_title.F:112
tagnod_r2r
subroutine tagnod_r2r(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart, flag, idom)
Definition tagnod_r2r.F:34
tagnod_r2r_s
subroutine tagnod_r2r_s(tagbuf)
Definition tagnod_r2r.F:201
tagnods_r2r
subroutine tagnods_r2r(ixs, ixs10, ixs20, ixs16, iparts, tagbuf, flag, idom)
Definition tagnod_r2r.F:265
tagnod_r2r_nl
subroutine tagnod_r2r_nl(ixc, ixtg, ixs, ixs10, ixs20, ixs16, tag_nlocal, mat_param)
Definition tagnod_r2r_nl.F:31