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
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 CHARACTER(LEN=NCHARTITLE) :: TITR1
82 INTEGER I,J,L,IBC1, IBC2, IBC3, NOINT, NTYP, IBID,
83 . INACTI, IBC1M, IBC2M, IBC3M, IGSTI,IS1,IS2,
84 . IGAP,MULTIMP,MFROT,IFQ,IBAG,MODFR,IERR1,IVIS2,
85 . ISYM,NOD1,IDUM,IGNORE,KK,II,IGAP0,IDELKEEP,
86 . IRSTH,ICURV,NA1,NA2,IFORM,IADM,IEDGE,NRADM,ISU10,ISU20,
87 . NOD10,NOD20,LINE10,LINE20,IBID1,IBID2,IDEL7N,LINE1,
88 . LINE2
90 . fric,gap,startt,bumult,stopt,c1,c2,c3,c4,c5,c6,alpha,
91 . visc,viscf,egde_angl,fpenmax,edg_angl,gapsol,stmin,stmax,
92 . padm,angladm,cadm,gapmax,gapscale
93 CHARACTER(LEN=40)::MESS
94 CHARACTER(LEN=NCHARTITLE)::MSGTITL
95 CHARACTER(LEN=NCHARKEY)::OPT,KEY,KEY1
96 CHARACTER(LEN=NCHARFIELD)::BCFLAG,BCFLAGM
97!
98 INTEGER, DIMENSION(:), POINTER :: INGR2USR
99C-----------------------------------------------
100C E x t e r n a l F u n c t i o n s
101C-----------------------------------------------
102 INTEGER NGR2USR
103 LOGICAL IS_AVAILABLE
104C-----------------------------------------------
105C=======================================================================
106C READING PENALTY INTERFACE /INTER/TYPE20
107C=======================================================================
108
109C Initializations
110 is1=0
111 is2=0
112 ibc1=0
113 ibc2=0
114 ibc3=0
115 ibc1m=0
116 ibc2m=0
117 ibc3m=0
118 mfrot=0
119 ifq=0
120 ibag=0
121 igsti = 0
122 idelkeep=0
123 nod1 = 0
124 multimp = 0
125 iform = 0
126 ibag = 0
127 idel7n=0
128 ivis2 = 0
129 nradm =1
130 iadm = 0
131C
132 stopt=ep30
133 inacti = 0
134 viscf = zero
135 fric = zero
136 gap = zero
137 startt = zero
138 visc = zero
139 xfiltr = zero
140 DO i = 1, 10
141 fric_p(i) = zero
142 ENDDO
143 c1=zero
144 c2=zero
145 c3=zero
146 c4=zero
147 c5=zero
148 c6=zero
149
150 gapsol = zero
151 stmin = zero
152 stmax = zero
153 fpenmax = zero
154 gapmax = zero
155 gapscale = zero
156 bumult = zero
157
158C ADMESH not read but initialized
159 padm =one
160 angladm=zero
161C
162 ntyp = 20
163 ipari(15)=noint
164 ipari(7)=ntyp
165C
166 is_available = .false.
167C--------------------------------------------------
168C EXTRACT DATAS (INTEGER VALUES)
169C--------------------------------------------------
170C
171 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
172 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
173 CALL hm_get_intv('I_sym',isym,is_available,lsubmodel)
174 CALL hm_get_intv('I_edge',iedge,is_available,lsubmodel)
175 CALL hm_get_intv('GRNOD_ID',nod1,is_available,lsubmodel)
176 CALL hm_get_intv('Line1_set',line1,is_available,lsubmodel)
177 CALL hm_get_intv('Line2_set',line2,is_available,lsubmodel)
178C
179 CALL hm_get_intv('Igap',igap,is_available,lsubmodel)
180 CALL hm_get_intv('Ibag',ibag,is_available,lsubmodel)
181 CALL hm_get_intv('NodDel3',idel7n,is_available,lsubmodel)
182C
183 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
184 CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
185 CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
186 CALL hm_get_intv('INACTIV',inacti,is_available,lsubmodel)
187C
188 CALL hm_get_intv('Ifric',mfrot,is_available,lsubmodel)
189 CALL hm_get_intv('Ifiltr',ifq,is_available,lsubmodel)
190 CALL hm_get_intv('IFORM',modfr,is_available,lsubmodel)
191C
192C--------------------------------------------------
193C EXTRACT DATAS (REAL VALUES)
194C--------------------------------------------------
195 CALL hm_get_floatv('ANGLE2',edg_angl,is_available,lsubmodel,unitab)
196C
197 CALL hm_get_floatv('FpenMax',fpenmax,is_available,lsubmodel,unitab)
198C
199 CALL hm_get_floatv('STFAC',stfac,is_available,lsubmodel,unitab)
200 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
201 CALL hm_get_floatv('MINI',gap,is_available,lsubmodel,unitab)
202 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
203 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
204C
205 CALL hm_get_floatv('STIFF_DC',visc,is_available,lsubmodel,unitab)
206 CALL hm_get_floatv('fric_dc',VISCF,IS_AVAILABLE,LSUBMODEL,UNITAB)
207C
208 CALL HM_GET_FLOATV('xfreq',ALPHA,IS_AVAILABLE,LSUBMODEL,UNITAB)
209C
210 IF (MFROT>0) THEN
211 CALL HM_GET_FLOATV('c1',C1,IS_AVAILABLE,LSUBMODEL,UNITAB)
212 CALL HM_GET_FLOATV('c2',C2,IS_AVAILABLE,LSUBMODEL,UNITAB)
213 CALL HM_GET_FLOATV('c3',C3,IS_AVAILABLE,LSUBMODEL,UNITAB)
214 CALL HM_GET_FLOATV('c4',C4,IS_AVAILABLE,LSUBMODEL,UNITAB)
215 CALL HM_GET_FLOATV('c5',C5,IS_AVAILABLE,LSUBMODEL,UNITAB)
216 ENDIF
217 IF (MFROT>1) THEN
218 CALL HM_GET_FLOATV('c6',C6,IS_AVAILABLE,LSUBMODEL,UNITAB)
219 ENDIF
220
221C
222C--------------------------------------------------
223C CHECKS And Storage IPARI FRIGAP
224C--------------------------------------------------
225C
226
227C
228C....* Card1 :flags *.............
229C
230
231 IF(ISYM == 0)ISYM = 1
232 IPARI(43)=ISYM
233
234 IS1=-1
235 IS2=-1
236 ISU10 = ISU1
237 ISU20 = ISU2
238 NOD10 = NOD1
239 LINE10 = LINE1
240 LINE20 = LINE2
241 INGR2USR => IGRSURF(1:NSURF)%ID
242 IF(ISU1 /= 0)ISU1=NGR2USR(ISU1,INGR2USR,NSURF)
243 IF(ISU2 == 0)THEN
244 IF(ISYM == 1)THEN
245 ISU2 = ISU1
246 ISU20 = ISU10
247 IPARI(43)=0
248 ENDIF
249 ELSE
250 ISU2 = NGR2USR(ISU2,INGR2USR,NSURF)
251 IF(ISYM == 1)THEN
252 IPARI(43)=1
253 ENDIF
254 ENDIF
255
256.AND. IF (ISU1 == 0 ISU2 == 0) IEDGE = -1
257 IPARI(58)=IEDGE
258
259.and. IF(IEDGE==3 EDG_ANGL==ZERO) EDG_ANGL=NINTY+ONE
260 FRIGAP(26) = COS((HUNDRED80-EDG_ANGL)*PI/HUNDRED80)
261
262 INGR2USR => IGRNOD(1:NGRNOD)%ID
263 IF(NOD1 /= 0) NOD1=NGR2USR(NOD1,INGR2USR,NGRNOD)
264 IPARI(26)=NOD1
265
266.and. IF(LINE2 == 0 ISU1 == 0)LINE2=LINE1
267 IF(IEDGE == 0)THEN
268 IF(LINE1 == LINE2)THEN
269 IPARI(42)=1
270 ELSE
271 IPARI(42)=0
272 ENDIF
273 ELSE
274.and. IF(LINE1 == LINE2 ISU1 == ISU2)THEN
275 IPARI(42)=1
276 ELSE
277 IPARI(42)=0
278 ENDIF
279 ENDIF
280
281 INGR2USR => IGRSLIN(1:NSLIN)%ID
282 IF(LINE1 /= 0)LINE1=NGR2USR(LINE1,INGR2USR,NSLIN)
283 IF(LINE2 /= 0)LINE2=NGR2USR(LINE2,INGR2USR,NSLIN)
284 IPARI(59)=LINE1
285 IPARI(60)=LINE2
286
287C.......* *........
288 IPARI(45)=ISU1
289 IPARI(46)=ISU2
290 IPARI(13)=IS1*10+IS2
291
292C
293C....* Card2 :flags *.............
294C
295
296 IF(IGSTI==0)IGSTI = 3
297 IF(ISMS==1) IGSTI = 4
298 IPARI(34)=IGSTI
299 IF (IDEL7N < 0) THEN
300 IDELKEEP=1
301 IDEL7N=ABS(IDEL7N)
302 END IF
303 IPARI(61)=IDELKEEP
304.OR. IF (IDEL7N>2N2D==1) IDEL7N = 0
305 IPARI(17)=IDEL7N
306
307.AND..AND. IF (IBAG/=0NVOLU==0 IALELAG == 0 ) THEN
308 CALL ANCMSG(MSGID=614,
309 . MSGTYPE=MSGWARNING,
310 . ANMODE=ANINFO_BLIND_2,
311 . I1=NOINT,
312 . C1=TITR)
313 IBAG=0
314 ENDIF
315 IPARI(32) = IBAG
316 INTBAG = MAX(INTBAG,IBAG)
317
318 KCONTACT =MAX(KCONTACT,IBAG,IADM)
319
320 IPARI(21)=IGAP
321
322C
323C....* Card4 *.............
324C
325
326 IF(IGAP==2)THEN
327 IF(GAPSCALE==ZERO)GAPSCALE=ONE
328 FRIGAP(13) = GAPSCALE
329 FRIGAP(16) = GAPMAX
330 END IF
331
332 IF(FRIGAP(16)==ZERO)THEN
333 GAPMAX=EP30
334 FRIGAP(16)=GAPMAX
335 END IF
336
337 IF (FPENMAX == ZERO) FPENMAX = ONE
338 FRIGAP(27) = FPENMAX
339 FRIGAP(29) = GAPSOL/FOUR
340C
341C....* Card6 *.............
342C
343 IF(IGSTI>1)THEN
344 I7STIFS=1
345 IF(STMAX==ZERO)STMAX=EP30
346 FRIGAP(17) = STMIN
347 FRIGAP(18) = STMAX
348 ELSE
349 STMIN = ZERO
350 STMAX = EP30
351 END IF
352
353.AND. IF(STFAC==ZEROIGSTI/=1) THEN
354 STFAC=ONE
355 ENDIF
356 IF (STFAC == ZERO )STFAC = ONE_FIFTH
357
358 IF (STOPT == ZERO) STOPT = EP30
359
360C.....* Storage IPARI FRIGAP *.......
361 FRIGAP(1)=FRIC
362 FRIGAP(2)=GAP
363 FRIGAP(3)=STARTT
364 FRIGAP(11)=STOPT
365
366C
367C....* Card7 *.............
368C
369
370C Hidden flag no more read using HM reader
371c IF (BCFLAGM(LFIELD-2:LFIELD-2)== '1') IBC1M = 1
372c IF (BCFLAGM(LFIELD-1:LFIELD-1)== '1') IBC2M = 1
373c IF (BCFLAGM(LFIELD :LFIELD )== '1') IBC3M = 1
374
375.AND. IF(FRIC/=ZEROVISCF==ZERO)VISCF=ONE
376 IF(VISC==ZERO)THEN
377 IF(IVIS2==5)THEN
378 VISC=ONE
379 ELSE
380 VISC=FIVEEM2
381 ENDIF
382 ENDIF
383
384 IPARI(22)=INACTI
385 IPARI(14)=IVIS2
386 IPARI(11)=4*IBC1+2*IBC2+IBC3 + 8 *(4*IBC1M+2*IBC2M+IBC3M)
387C
388C....* Card8 : FRICTION data *.............
389C
390
391.AND. IF (MFROT/=0VISCF==0.0) VISCF=ONE
392
393 IF (ALPHA==0.) IFQ = 0
394
395 IF (MODFR==0) MODFR = 2
396.AND. IF (MODFR==2IFQ<10) IFQ = IFQ + 10
397 IF(MODFR==2)VISCF=ZERO
398
399 IF (IFQ>0) THEN
400 IF (IFQ==10) XFILTR = ONE
401 IF (MOD(IFQ,10)==1) XFILTR = ALPHA
402 IF (MOD(IFQ,10)==2) XFILTR=FOUR*ATAN2(ONE,ZERO) / ALPHA
403 IF (MOD(IFQ,10)==3) XFILTR=FOUR*ATAN2(ONE,ZERO) * ALPHA
404 IF (XFILTR<ZERO) THEN
405 CALL ANCMSG(MSGID=554,
406 . MSGTYPE=MSGERROR,
407 . ANMODE=ANINFO_BLIND_1,
408 . I1=NOINT,
409 . C1=TITR,
410 . R1=ALPHA)
411.AND. ELSEIF (XFILTR>1MOD(IFQ,10)<=2) THEN
412 CALL ANCMSG(MSGID=554,
413 . MSGTYPE=MSGERROR,
414 . ANMODE=ANINFO_BLIND_1,
415 . I1=NOINT,
416 . C1=TITR,
417 . R1=ALPHA)
418 ENDIF
419 ELSE
420 XFILTR = ZERO
421 ENDIF
422
423C
424C....* Card9 : FRICTION data *.............
425C
426
427 FRIC_P(1) = C1
428 FRIC_P(2) = C2
429 FRIC_P(3) = C3
430 FRIC_P(4) = C4
431 FRIC_P(5) = C5
432 FRIC_P(6) = C6
433
434 IPARI(30) = MFROT
435 IPARI(31) = IFQ
436 FRIGAP(14)=VISC
437 FRIGAP(15)=VISCF**2
438
439C------------------------------------------------------------
440C General Storage IPARI FRIGAP
441C------------------------------------------------------------
442
443 CADM =COS(ANGLADM*PI/HUNDRED80)
444 IPARI(49) =NRADM
445 FRIGAP(24)=PADM
446 FRIGAP(25)=CADM
447
448C BUMULT is increased for big models
449 IF(BUMULT==ZERO) THEN
450 BUMULT = BMUL0
451 IF(NUMNOD > 2500000) THEN
452 BUMULT = BMUL0*TWO
453 ELSEIF(NUMNOD > 1500000) THEN
454 BUMULT = BMUL0*THREE/TWO
455 END IF
456 END IF
457 FRIGAP(4)=BUMULT
458
459C FRIGAP(10) is initialized but used only in engine for storing number of couples candidates
460 FRIGAP(10)=FLOAT(0)
461
462 MULTIMP = 4
463 IPARI(23)=MULTIMP
464C
465C------------------------------------------------------------
466C PRINTOUT
467C------------------------------------------------------------
468C
469 WRITE(IOUT,3507)
470 . ISU10,ISU20,ISYM,MAX(IEDGE,0),NOD10,LINE10,LINE20,
471 . EDG_ANGL,
472 . IBC1,IBC2,IBC3,IBC1M,IBC2M,IBC3M,
473 . IGSTI,STFAC,STMIN,STMAX,
474 . FRIC,IGAP,GAP,GAPSOL,STARTT,STOPT,
475 . INACTI,FPENMAX,VISC,VISCF,IPARI(14),
476 . IPARI(20),MULTIMP
477
478C
479C--------------------------------------------------------------
480 IF(IS1==0)THEN
481 WRITE(IOUT,'(6x,a)')'no secondary surface input'
482 ELSEIF(IS1==1)THEN
483 WRITE(IOUT,'(6x,a)')'secondary surface input by segments'
484 ELSEIF(IS1==2)THEN
485 WRITE(IOUT,'(6x,a)')'secondary surface input by nodes'
486 ELSEIF(IS1==3)THEN
487 WRITE(IOUT,'(6x,a)')'secondary surface input by segments'
488 ELSEIF(IS1==4 )THEN
489 WRITE(IOUT,'(6x,a)')'secondary side input by bricks'
490 ELSEIF(IS1==5 )THEN
491 WRITE(IOUT,'(6x,a)')'secondary side input by solid elements'
492 ENDIF
493 IF(IS2==0)THEN
494 WRITE(IOUT,'(6x,a)')'no main surface input'
495 ELSEIF(IS2==1)THEN
496 WRITE(IOUT,'(6x,a)')'main surface input by segments'
497 ELSEIF(IS2==2)THEN
498 WRITE(IOUT,'(6x,a)')'main surface input by nodes'
499 ELSEIF(IS2==3)THEN
500 WRITE(IOUT,'(6x,a)')'main surface input by segments'
501 ELSEIF(IS2==4)THEN
502 WRITE(IOUT,'(6x,a)')'MAIN SURFACE REFERS ',
503 . 'TO HYPER-ELLIPSOIDAL SURFACE'
504 ENDIF
505C
506C--------------------------------------------------------------
507 1000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
508 1300 FORMAT( /1x,' INTERFACES ' /
509 . 1x,' -------------- '// )
510C------------
511 RETURN
512 3507 FORMAT(//
513 . ' TYPE==20 PARALLEL/AUTO IMPACTING ' //,
514 . ' FIRST SURFACE ID. . . . . . . . . . . . . ',i10/,
515 . ' SECOND SURFACE ID . . . . . . . . . . . . ',i10/,
516 . ' SYMMETRY FLAG . . . . . . . . . . . . . . ',i10/,
517 . ' EDGE FLAG . . . . . . . . . . . . . . . . ',i10/,
518 . ' =0 No edges'/,
519 . ' =1 Edges from surface border'/,
520 . ' =2 Edges from each segment(element) edge'/,
521 . ' =3 same as 1 + sharp edges between segment'/,
522 . ' NOD GROUP ID (ADDITIONAL) . . . . . . . . ',i10/,
523 . ' FIRST LINE ID (ADDITIONAL). . . . . . . . ',i10/,
524 . ' SECOND LINE ID (ADDITIONAL) . . . . . . . ',i10/,
525 . ' ANGLE FOR EDGE COMPUTATION (Iedge=3). . . ',1pg20.13/,
526 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
527 . ' SECONDARY NODE (1:YES 0:NO) Y DIR ',i1/,
528 . ' Z DIR ',i1/,
529 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
530 . ' MAIN NODE (1:YES 0:NO) Y DIR ',i1/,
531 . ' Z DIR ',i1/,
532 . ' STIFFNESS FORMULATION. . . . . . . . . . ',i1/,
533 . ' STIFFNESS FACTOR OR STIFFNESS VALUE . . . ',1pg20.13/,
534 . ' MINIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
535 . ' MAXIMUM STIFFNESS. . . . . . . . . . . . ',1pg20.13/,
536 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
537 . ' VARIABLE GAP FLAG . . . . . . . . . . . . ',i10/,
538 . ' MINIMUM GAP . . . . . . . . . . . . . . . ',1pg20.13/,
539 . ' MINIMUM SOLID THICKNESS . . . . . . . . . ',1pg20.13/,
540 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
541 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
542 . ' DE-ACTIVATION OF INITIAL PENETRATIONS . . ',i10/,
543 . ' MAXIMAL INITIAL PENETRATION FACTOR. . . . ',1pg20.13/,
544 . ' CRITICAL DAMPING FACTOR . . . . . . . . . ',1pg20.13/,
545 . ' FRICTION CRITICAL DAMPING FACTOR. . . . . ',1pg20.13/,
546 . ' QUADRATIC DAMPING FLAG. . . . . . . . . . ',i10/,
547 . ' FORMULATION LEVEL . . . . . . . . . . . . ',i10/,
548 . ' MEAN POSSIBLE NUMBER OF IMPACT/NODE . . . ',i10/)
549C----------
550
551
#define my_real
Definition cppsort.cpp:32
#define alpha
Definition eval.h:35
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
integer, parameter nchartitle
integer, parameter ncharkey
integer, parameter ncharfield
int main(int argc, char *argv[])