OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type20.F File Reference
#include "implicit_f.inc"
#include "sms_c.inc"
#include "scr06_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr12_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type20 (ipari, stfac, frigap, noint, igrnod, igrsurf, igrslin, xfiltr, fric_p, unitab, lsubmodel, titr)

Function/Subroutine Documentation

◆ hm_read_inter_type20()

subroutine hm_read_inter_type20 ( integer, dimension(*) ipari,
stfac,
frigap,
integer noint,
type (group_), dimension(ngrnod), target igrnod,
type (surf_), dimension(nsurf), target igrsurf,
type (surf_), dimension(nslin), target igrslin,
xfiltr,
fric_p,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(nsubmod) lsubmodel,
character(len=nchartitle), intent(in) titr )

Definition at line 36 of file hm_read_inter_type20.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE groupdef_mod
45 USE submodel_mod
46 USE unitab_mod
47 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "sms_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ISU1,ISU2
60 INTEGER IPARI(*)
61 my_real stfac,xfiltr
62 my_real frigap(*),fric_p(10)
63 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
64C-----------------------------------------------
65 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
66 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
67 TYPE (SURF_) ,TARGET , DIMENSION(NSLIN) :: IGRSLIN
68 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
69 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "scr06_c.inc"
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "units_c.inc"
77#include "scr12_c.inc"
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81
82 INTEGER I,IBC1, IBC2, IBC3, NOINT, NTYP,
83 . INACTI, IBC1M, IBC2M, IBC3M, IGSTI,IS1,IS2,
84 . IGAP,MULTIMP,MFROT,IFQ,IBAG,MODFR,IVIS2,
85 . ISYM,NOD1,IDELKEEP,
86 . IFORM,IADM,IEDGE,NRADM,ISU10,ISU20,
87 . NOD10,LINE10,LINE20,IDEL7N,LINE1,
88 . LINE2
89 my_real
90 . fric,gap,startt,bumult,stopt,c1,c2,c3,c4,c5,c6,alpha,
91 . visc,viscf,fpenmax,edg_angl,gapsol,stmin,stmax,
92 . padm,angladm,cadm,gapmax,gapscale
93
94!
95 INTEGER, DIMENSION(:), POINTER :: INGR2USR
96C-----------------------------------------------
97C E x t e r n a l F u n c t i o n s
98C-----------------------------------------------
99 INTEGER NGR2USR
100 LOGICAL IS_AVAILABLE
101C-----------------------------------------------
102C=======================================================================
103C READING PENALTY INTERFACE /INTER/TYPE20
104C=======================================================================
105
106C Initializations
107 is1=0
108 is2=0
109 ibc1=0
110 ibc2=0
111 ibc3=0
112 ibc1m=0
113 ibc2m=0
114 ibc3m=0
115 mfrot=0
116 ifq=0
117 ibag=0
118 igsti = 0
119 idelkeep=0
120 nod1 = 0
121 multimp = 0
122 iform = 0
123 ibag = 0
124 idel7n=0
125 ivis2 = 0
126 nradm =1
127 iadm = 0
128C
129 stopt=ep30
130 inacti = 0
131 viscf = zero
132 fric = zero
133 gap = zero
134 startt = zero
135 visc = zero
136 xfiltr = zero
137 DO i = 1, 10
138 fric_p(i) = zero
139 ENDDO
140 c1=zero
141 c2=zero
142 c3=zero
143 c4=zero
144 c5=zero
145 c6=zero
146
147 gapsol = zero
148 stmin = zero
149 stmax = zero
150 fpenmax = zero
151 gapmax = zero
152 gapscale = zero
153 bumult = zero
154
155C ADMESH not read but initialized
156 padm =one
157 angladm=zero
158C
159 ntyp = 20
160 ipari(15)=noint
161 ipari(7)=ntyp
162C
163 is_available = .false.
164C--------------------------------------------------
165C EXTRACT DATAS (INTEGER VALUES)
166C--------------------------------------------------
167C
168 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
169 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
170 CALL hm_get_intv('I_sym',isym,is_available,lsubmodel)
171 CALL hm_get_intv('I_edge',iedge,is_available,lsubmodel)
172 CALL hm_get_intv('GRNOD_ID',nod1,is_available,lsubmodel)
173 CALL hm_get_intv('Line1_set',line1,is_available,lsubmodel)
174 CALL hm_get_intv('Line2_set',line2,is_available,lsubmodel)
175C
176 CALL hm_get_intv('Igap',igap,is_available,lsubmodel)
177 CALL hm_get_intv('Ibag',ibag,is_available,lsubmodel)
178 CALL hm_get_intv('NodDel3',idel7n,is_available,lsubmodel)
179C
180 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
181 CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
182 CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
183 CALL hm_get_intv('INACTIV',inacti,is_available,lsubmodel)
184C
185 CALL hm_get_intv('Ifric',mfrot,is_available,lsubmodel)
186 CALL hm_get_intv('Ifiltr',ifq,is_available,lsubmodel)
187 CALL hm_get_intv('IFORM',modfr,is_available,lsubmodel)
188C
189C--------------------------------------------------
190C EXTRACT DATAS (REAL VALUES)
191C--------------------------------------------------
192 CALL hm_get_floatv('ANGLE2',edg_angl,is_available,lsubmodel,unitab)
193C
194 CALL hm_get_floatv('FpenMax',fpenmax,is_available,lsubmodel,unitab)
195C
196 CALL hm_get_floatv('STFAC',stfac,is_available,lsubmodel,unitab)
197 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
198 CALL hm_get_floatv('MINI',gap,is_available,lsubmodel,unitab)
199 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
200 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
201C
202 CALL hm_get_floatv('STIFF_DC',visc,is_available,lsubmodel,unitab)
203 CALL hm_get_floatv('FRIC_DC',viscf,is_available,lsubmodel,unitab)
204C
205 CALL hm_get_floatv('Xfreq',alpha,is_available,lsubmodel,unitab)
206C
207 IF (mfrot>0) THEN
208 CALL hm_get_floatv('C1',c1,is_available,lsubmodel,unitab)
209 CALL hm_get_floatv('C2',c2,is_available,lsubmodel,unitab)
210 CALL hm_get_floatv('C3',c3,is_available,lsubmodel,unitab)
211 CALL hm_get_floatv('C4',c4,is_available,lsubmodel,unitab)
212 CALL hm_get_floatv('C5',c5,is_available,lsubmodel,unitab)
213 ENDIF
214 IF (mfrot>1) THEN
215 CALL hm_get_floatv('C6',c6,is_available,lsubmodel,unitab)
216 ENDIF
217
218C
219C--------------------------------------------------
220C CHECKS And Storage IPARI FRIGAP
221C--------------------------------------------------
222C
223
224C
225C....* Card1 :flags *.............
226C
227
228 IF(isym == 0)isym = 1
229 ipari(43)=isym
230
231 is1=-1
232 is2=-1
233 isu10 = isu1
234 isu20 = isu2
235 nod10 = nod1
236 line10 = line1
237 line20 = line2
238 ingr2usr => igrsurf(1:nsurf)%ID
239 IF(isu1 /= 0)isu1=ngr2usr(isu1,ingr2usr,nsurf)
240 IF(isu2 == 0)THEN
241 IF(isym == 1)THEN
242 isu2 = isu1
243 isu20 = isu10
244 ipari(43)=0
245 ENDIF
246 ELSE
247 isu2 = ngr2usr(isu2,ingr2usr,nsurf)
248 IF(isym == 1)THEN
249 ipari(43)=1
250 ENDIF
251 ENDIF
252
253 IF (isu1 == 0 .AND. isu2 == 0) iedge = -1
254 ipari(58)=iedge
255
256 IF(iedge==3 .and. edg_angl==zero) edg_angl=ninety+one
257 frigap(26) = cos((hundred80-edg_angl)*pi/hundred80)
258
259 ingr2usr => igrnod(1:ngrnod)%ID
260 IF(nod1 /= 0) nod1=ngr2usr(nod1,ingr2usr,ngrnod)
261 ipari(26)=nod1
262
263 IF(line2 == 0 .and. isu1 == 0)line2=line1
264 IF(iedge == 0)THEN
265 IF(line1 == line2)THEN
266 ipari(42)=1
267 ELSE
268 ipari(42)=0
269 ENDIF
270 ELSE
271 IF(line1 == line2 .and. isu1 == isu2)THEN
272 ipari(42)=1
273 ELSE
274 ipari(42)=0
275 ENDIF
276 ENDIF
277
278 ingr2usr => igrslin(1:nslin)%ID
279 IF(line1 /= 0)line1=ngr2usr(line1,ingr2usr,nslin)
280 IF(line2 /= 0)line2=ngr2usr(line2,ingr2usr,nslin)
281 ipari(59)=line1
282 ipari(60)=line2
283
284C.......* *........
285 ipari(45)=isu1
286 ipari(46)=isu2
287 ipari(13)=is1*10+is2
288
289C
290C....* Card2 :flags *.............
291C
292
293 IF(igsti==0)igsti = 3
294 IF(isms==1) igsti = 4
295 ipari(34)=igsti
296 IF (idel7n < 0) THEN
297 idelkeep=1
298 idel7n=abs(idel7n)
299 END IF
300 ipari(61)=idelkeep
301 IF (idel7n>2.OR.n2d==1) idel7n = 0
302 ipari(17)=idel7n
303
304 IF (ibag/=0.AND.nvolu==0 .AND. ialelag == 0 ) THEN
305 CALL ancmsg(msgid=614,
306 . msgtype=msgwarning,
307 . anmode=aninfo_blind_2,
308 . i1=noint,
309 . c1=titr)
310 ibag=0
311 ENDIF
312 ipari(32) = ibag
313 intbag = max(intbag,ibag)
314
315 kcontact =max(kcontact,ibag,iadm)
316
317 ipari(21)=igap
318
319C
320C....* Card4 *.............
321C
322
323 IF(igap==2)THEN
324 IF(gapscale==zero)gapscale=one
325 frigap(13) = gapscale
326 frigap(16) = gapmax
327 END IF
328
329 IF(frigap(16)==zero)THEN
330 gapmax=ep30
331 frigap(16)=gapmax
332 END IF
333
334 IF (fpenmax == zero) fpenmax = one
335 frigap(27) = fpenmax
336 frigap(29) = gapsol/four
337C
338C....* Card6 *.............
339C
340 IF(igsti>1)THEN
341 i7stifs=1
342 IF(stmax==zero)stmax=ep30
343 frigap(17) = stmin
344 frigap(18) = stmax
345 ELSE
346 stmin = zero
347 stmax = ep30
348 END IF
349
350 IF(stfac==zero.AND.igsti/=1) THEN
351 stfac=one
352 ENDIF
353 IF (stfac == zero )stfac = one_fifth
354
355 IF (stopt == zero) stopt = ep30
356
357C.....* Storage IPARI FRIGAP *.......
358 frigap(1)=fric
359 frigap(2)=gap
360 frigap(3)=startt
361 frigap(11)=stopt
362
363C
364C....* Card7 *.............
365C
366
367C Hidden flag no more read using HM reader
368c IF (BCFLAGM(LFIELD-2:LFIELD-2)== '1') IBC1M = 1
369c IF (BCFLAGM(LFIELD-1:LFIELD-1)== '1') IBC2M = 1
370c IF (BCFLAGM(LFIELD :LFIELD )== '1') IBC3M = 1
371
372 IF(fric/=zero.AND.viscf==zero)viscf=one
373 IF(visc==zero)THEN
374 IF(ivis2==5)THEN
375 visc=one
376 ELSE
377 visc=fiveem2
378 ENDIF
379 ENDIF
380
381 ipari(22)=inacti
382 ipari(14)=ivis2
383 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
384C
385C....* Card8 : FRICTION data *.............
386C
387
388 IF (mfrot/=0.AND.viscf==0.0) viscf=one
389
390 IF (alpha==0.) ifq = 0
391
392 IF (modfr==0) modfr = 2
393 IF (modfr==2.AND.ifq<10) ifq = ifq + 10
394 IF(modfr==2)viscf=zero
395
396 IF (ifq>0) THEN
397 IF (ifq==10) xfiltr = one
398 IF (mod(ifq,10)==1) xfiltr = alpha
399 IF (mod(ifq,10)==2) xfiltr=four*atan2(one,zero) / alpha
400 IF (mod(ifq,10)==3) xfiltr=four*atan2(one,zero) * alpha
401 IF (xfiltr<zero) THEN
402 CALL ancmsg(msgid=554,
403 . msgtype=msgerror,
404 . anmode=aninfo_blind_1,
405 . i1=noint,
406 . c1=titr,
407 . r1=alpha)
408 ELSEIF (xfiltr>1.AND.mod(ifq,10)<=2) THEN
409 CALL ancmsg(msgid=554,
410 . msgtype=msgerror,
411 . anmode=aninfo_blind_1,
412 . i1=noint,
413 . c1=titr,
414 . r1=alpha)
415 ENDIF
416 ELSE
417 xfiltr = zero
418 ENDIF
419
420C
421C....* Card9 : FRICTION data *.............
422C
423
424 fric_p(1) = c1
425 fric_p(2) = c2
426 fric_p(3) = c3
427 fric_p(4) = c4
428 fric_p(5) = c5
429 fric_p(6) = c6
430
431 ipari(30) = mfrot
432 ipari(31) = ifq
433 frigap(14)=visc
434 frigap(15)=viscf**2
435
436C------------------------------------------------------------
437C General Storage IPARI FRIGAP
438C------------------------------------------------------------
439
440 cadm =cos(angladm*pi/hundred80)
441 ipari(49) =nradm
442 frigap(24)=padm
443 frigap(25)=cadm
444
445C BUMULT is increased for big models
446 IF(bumult==zero) THEN
447 bumult = bmul0
448 IF(numnod > 2500000) THEN
449 bumult = bmul0*two
450 ELSEIF(numnod > 1500000) THEN
451 bumult = bmul0*three/two
452 END IF
453 END IF
454 frigap(4)=bumult
455
456C FRIGAP(10) is initialized but used only in engine for storing number of couples candidates
457 frigap(10)=float(0)
458
459 multimp = 4
460 ipari(23)=multimp
461C
462C------------------------------------------------------------
463C PRINTOUT
464C------------------------------------------------------------
465C
466 WRITE(iout,3507)
467 . isu10,isu20,isym,max(iedge,0),nod10,line10,line20,
468 . edg_angl,
469 . ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
470 . igsti,stfac,stmin,stmax,
471 . fric,igap,gap,gapsol,startt,stopt,
472 . inacti,fpenmax,visc,viscf,ipari(14),
473 . ipari(20),multimp
474
475C
476C--------------------------------------------------------------
477 IF(is1==0)THEN
478 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
479 ELSEIF(is1==1)THEN
480 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
481 ELSEIF(is1==2)THEN
482 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
483 ELSEIF(is1==3)THEN
484 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
485 ELSEIF(is1==4 )THEN
486 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
487 ELSEIF(is1==5 )THEN
488 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
489 ENDIF
490 IF(is2==0)THEN
491 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
492 ELSEIF(is2==1)THEN
493 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
494 ELSEIF(is2==2)THEN
495 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
496 ELSEIF(is2==3)THEN
497 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
498 ELSEIF(is2==4)THEN
499 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
500 . 'TO HYPER-ELLIPSOIDAL SURFACE'
501 ENDIF
502C
503C--------------------------------------------------------------
504C------------
505 RETURN
506 3507 FORMAT(//
507 . ' TYPE==20 PARALLEL/AUTO IMPACTING ' //,
508 . ' FIRST SURFACE ID. . . . . . . . . . . . . ',i10/,
509 . ' SECOND SURFACE ID . . . . . . . . . . . . ',i10/,
510 . ' SYMMETRY FLAG . . . . . . . . . . . . . . ',i10/,
511 . ' EDGE FLAG . . . . . . . . . . . . . . . . ',i10/,
512 . ' =0 No edges'/,
513 . ' =1 Edges from surface border'/,
514 . ' =2 Edges from each segment(element) edge'/,
515 . ' =3 same as 1 + sharp edges between segment'/,
516 . ' NOD GROUP ID (ADDITIONAL) . . . . . . . . ',i10/,
517 . ' FIRST LINE ID (ADDITIONAL). . . . . . . . ',i10/,
518 . ' SECOND LINE ID (ADDITIONAL) . . . . . . . ',i10/,
519 . ' ANGLE FOR EDGE COMPUTATION (Iedge=3). . . ',1pg20.13/,
520 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
521 . ' SECONDARY NODE (1:YES 0:NO) Y DIR ',i1/,
522 . ' Z DIR ',i1/,
523 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
524 . ' MAIN NODE (1:YES 0:NO) Y DIR ',i1/,
525 . ' Z DIR ',i1/,
526 . ' STIFFNESS FORMULATION. . . . . . . . . . ',i1/,
527 . ' STIFFNESS FACTOR OR STIFFNESS VALUE . . . ',1pg20.13/,
528 . ' MINIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
529 . ' MAXIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
530 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
531 . ' VARIABLE GAP FLAG . . . . . . . . . . . . ',i10/,
532 . ' MINIMUM GAP . . . . . . . . . . . . . . . ',1pg20.13/,
533 . ' MINIMUM SOLID THICKNESS . . . . . . . . . ',1pg20.13/,
534 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
535 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
536 . ' DE-ACTIVATION OF INITIAL PENETRATIONS . . ',i10/,
537 . ' MAXIMAL INITIAL PENETRATION FACTOR. . . . ',1pg20.13/,
538 . ' CRITICAL DAMPING FACTOR . . . . . . . . . ',1pg20.13/,
539 . ' FRICTION CRITICAL DAMPING FACTOR. . . . . ',1pg20.13/,
540 . ' QUADRATIC DAMPING FLAG. . . . . . . . . . ',i10/,
541 . ' FORMULATION LEVEL . . . . . . . . . . . . ',i10/,
542 . ' MEAN POSSIBLE NUMBER OF IMPACT/NODE . . . ',i10/)
543C----------
544
545
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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:895