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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type05 (ipari, stfac, frigap, noint, ni, igrnod, igrsurf, nom_opt, xfiltr, fric_p, sensors, unitab, lsubmodel, titr, npari, nparir)

Function/Subroutine Documentation

◆ hm_read_inter_type05()

subroutine hm_read_inter_type05 ( integer, dimension(npari) ipari,
stfac,
frigap,
integer noint,
integer ni,
type (group_), dimension(ngrnod), target igrnod,
type (surf_), dimension(nsurf), target igrsurf,
integer, dimension(lnopt1,*) nom_opt,
xfiltr,
fric_p,
type (sensors_), intent(in) sensors,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*) lsubmodel,
character(len=nchartitle) titr,
integer, intent(in) npari,
integer, intent(in) nparir )
Parameters
[in]nparirarray sizes (IPARI and FRIGAP)

Definition at line 37 of file hm_read_inter_type05.F.

42C============================================================================
43C
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE message_mod
48 USE groupdef_mod
49 USE submodel_mod
50 USE unitab_mod
51 USE sensor_mod
52 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "scr17_c.inc"
61#include "sphcom.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER,INTENT(IN) :: NPARI, NPARIR !< array sizes (IPARI and FRIGAP)
66 INTEGER ISU1,ISU2,NI,NOINT
67 INTEGER NOM_OPT(LNOPT1,*),IPARI(NPARI)
68 my_real stfac,xfiltr
69 my_real frigap(nparir),fric_p(10)
70 CHARACTER(LEN=NCHARTITLE) :: TITR
71C-----------------------------------------------
72 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
73 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
74 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
75 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
76 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
77C-----------------------------------------------
78C C o m m o n B l o c k s
79C-----------------------------------------------
80#include "com01_c.inc"
81#include "com04_c.inc"
82#include "units_c.inc"
83#include "remesh_c.inc"
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I,IBC1, IBC2, IBC3, IBUC, NTYP, INACTI, IBC1M, IBC2M, IBC3M, IGSTI, IS1, IS2
88 INTEGER ILEV, MFROT,IFQ,IBAG,IDEL5,IDSENS,IDELKEEP, INTKG,IADM,MULTIMP,IRM,NRADM
89 my_real fric,gap,startt,stopt,c1,c2,c3,c4,c5,c6,alpha,visc,ptmax,padm,angladm
90 INTEGER, DIMENSION(:), POINTER :: INGR2USR
91C-----------------------------------------------
92C E x t e r n a l F u n c t i o n s
93C-----------------------------------------------
94 INTEGER NGR2USR
95 LOGICAL IS_AVAILABLE
96C-----------------------------------------------
97C=======================================================================
98C READING PENALTY INTERFACE /INTER/TYPE5
99C=======================================================================
100
101C Initializations
102 is1=0
103 is2=0
104 ibc1=0
105 ibc2=0
106 ibc3=0
107 ibc1m=0
108 ibc2m=0
109 ibc3m=0
110 ibuc=0
111 mfrot=0
112 ifq=0
113 ibag=0
114 igsti = 0
115 ilev=0
116 idsens = 0
117 idelkeep=0
118 intkg = 0
119 inacti = 0
120 idel5 = 0
121 multimp = 0
122 iadm =0
123 nradm=1
124C
125 stopt=ep30
126
127 fric = zero
128 gap = zero
129 startt = zero
130 visc = zero
131 xfiltr = zero
132 DO i = 1, 10
133 fric_p(i) = zero
134 ENDDO
135 c1=zero
136 c2=zero
137 c3=zero
138 c4=zero
139 c5=zero
140 c6=zero
141
142 ptmax=ep30
143
144 padm =one
145 angladm=zero
146C
147
148 ntyp = 5
149 ipari(15)=noint
150 ipari(7)=ntyp
151C
152 is_available = .false.
153C--------------------------------------------------
154C EXTRACT DATAS (INTEGER VALUES)
155C--------------------------------------------------
156C
157 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
158 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
159 CALL hm_get_intv('Ibag',ibag,is_available,lsubmodel)
160 CALL hm_get_intv('NodDel5',idel5,is_available,lsubmodel)
161C
162 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
163 CALL hm_get_intv('deactivate_y_bc',IBC2,IS_AVAILABLE,LSUBMODEL)
164 CALL HM_GET_INTV('deactivate_z_bc',IBC3,IS_AVAILABLE,LSUBMODEL)
165 CALL HM_GET_INTV('vflag',IRM,IS_AVAILABLE,LSUBMODEL)
166 CALL HM_GET_INTV('inactiv',INACTI,IS_AVAILABLE,LSUBMODEL)
167C
168 CALL HM_GET_INTV('ifric',MFROT,IS_AVAILABLE,LSUBMODEL)
169 CALL HM_GET_INTV('ifiltr',IFQ,IS_AVAILABLE,LSUBMODEL)
170 CALL HM_GET_INTV('isensor',IDSENS,IS_AVAILABLE,LSUBMODEL)
171C
172C--------------------------------------------------
173C EXTRACT DATAS (REAL VALUES)
174C--------------------------------------------------
175
176 CALL HM_GET_FLOATV('type5_scale',STFAC,IS_AVAILABLE,LSUBMODEL,UNITAB)
177 CALL HM_GET_FLOATV('fric',FRIC,IS_AVAILABLE,LSUBMODEL,UNITAB)
178 CALL HM_GET_FLOATV('gap',GAP,IS_AVAILABLE,LSUBMODEL,UNITAB)
179 CALL HM_GET_FLOATV('tstart',STARTT,IS_AVAILABLE,LSUBMODEL,UNITAB)
180 CALL HM_GET_FLOATV('tstop',STOPT,IS_AVAILABLE,LSUBMODEL,UNITAB)
181C
182 CALL HM_GET_FLOATV('xfreq',ALPHA,IS_AVAILABLE,LSUBMODEL,UNITAB)
183 CALL HM_GET_FLOATV('ptlim',PTMAX,IS_AVAILABLE,LSUBMODEL,UNITAB)
184C
185 IF (MFROT>0) THEN
186 CALL HM_GET_FLOATV('c1',C1,IS_AVAILABLE,LSUBMODEL,UNITAB)
187 CALL HM_GET_FLOATV('c2',C2,IS_AVAILABLE,LSUBMODEL,UNITAB)
188 CALL HM_GET_FLOATV('c3',C3,IS_AVAILABLE,LSUBMODEL,UNITAB)
189 CALL HM_GET_FLOATV('c4',C4,IS_AVAILABLE,LSUBMODEL,UNITAB)
190 CALL HM_GET_FLOATV('c5',C5,IS_AVAILABLE,LSUBMODEL,UNITAB)
191 ENDIF
192 IF (MFROT>1) THEN
193 CALL HM_GET_FLOATV('c6',C6,IS_AVAILABLE,LSUBMODEL,UNITAB)
194 ENDIF
195
196C
197C--------------------------------------------------
198C CHECKS And Storage IPARI FRIGAP
199C--------------------------------------------------
200C
201
202C
203C....* Card1 :flags *.............
204C
205 IS1=2
206 IS2=1
207 INGR2USR => IGRNOD(1:NGRNOD)%ID
208 ISU1=NGR2USR(ISU1,INGR2USR,NGRNOD)
209 INGR2USR => IGRSURF(1:NSURF)%ID
210 ISU2=NGR2USR(ISU2,INGR2USR,NSURF)
211
212 IPARI(45)=ISU1
213 IPARI(46)=ISU2
214 IPARI(13)=IS1*10+IS2
215
216
217 IF (IDEL5 < 0) THEN
218 IDELKEEP=1
219 IDEL5=ABS(IDEL5)
220 END IF
221 IPARI(61)=IDELKEEP
222.OR. IF (IDEL5>2N2D==1) IDEL5 = 0
223 IPARI(17)=IDEL5
224
225.AND..AND..AND. IF (IBAG/=0NVOLU==0IALELAG==0NSPHSOL==0) THEN
226 CALL ANCMSG(MSGID=614,
227 . MSGTYPE=MSGWARNING,
228 . ANMODE=ANINFO_BLIND_2,
229 . I1=NOINT,
230 . C1=TITR)
231 IBAG=0
232 ENDIF
233 IPARI(32)=IBAG
234
235C Iadm has not been implemented for TYPE5 yet.
236.AND. IF (IADM/=0NADMESH==0) THEN
237 CALL ANCMSG(MSGID=647,
238 . MSGTYPE=MSGWARNING,
239 . ANMODE=ANINFO_BLIND_2,
240 . I1=NOINT,
241 . C1=TITR)
242 IADM=0
243 ENDIF
244 IPARI(44)=IADM
245
246 KCONTACT =MAX(KCONTACT,IBAG,IADM)
247 INTBAG=MAX(INTBAG,IBAG)
248
249 IPARI(20)=ILEV
250
251C
252C....* Card2 *.............
253C
254 IF (STFAC == ZERO) STFAC = ONE_FIFTH
255
256 IF (STOPT == ZERO) STOPT = EP30
257
258 FRIGAP(1)=FRIC
259 FRIGAP(2)=GAP
260 FRIGAP(3)=STARTT
261 FRIGAP(11)=STOPT
262C
263C....* Card3 *.............
264C
265 IPARI(11)=4*IBC1+2*IBC2+IBC3 + 8 *(4*IBC1M+2*IBC2M+IBC3M)
266 IPARI(22)=INACTI
267 FRIGAP(14)=VISC
268 IPARI(24) = IRM
269C
270C....* Card4 : FRICTION data *.............
271C
272
273 IF(PTMAX==ZERO) PTMAX=EP30
274 FRIGAP(16)=PTMAX
275
276 IF (ALPHA==0) IFQ = 0
277 IF (IFQ>0) THEN
278 IF (IFQ==1) XFILTR = ALPHA
279 IF (IFQ==2) XFILTR = FOUR*ATAN2(ONE,ZERO) / ALPHA
280 IF (IFQ==3) XFILTR = FOUR*ATAN2(ONE,ZERO) * ALPHA
281.OR..AND. IF (XFILTR<0(IFQ<=2XFILTR>1.)) THEN
282 CALL ANCMSG(MSGID=554,
283 . MSGTYPE=MSGERROR,
284 . ANMODE=ANINFO_BLIND_1,
285 . I1=NOINT,
286 . C1=TITR,
287 . R1=ALPHA)
288 ENDIF
289 ELSE
290 XFILTR = ZERO
291 ENDIF
292 IPARI(31)=IFQ
293
294 IPARI(64) = IDSENS
295 IPARI(30) = MFROT
296
297C
298C....* Card4 : OPTIONAL Card8 Card9 : C1...C6 friction data *
299C
300 FRIC_P(1)=C1
301 FRIC_P(2)=C2
302 FRIC_P(3)=C3
303 FRIC_P(4)=C4
304 FRIC_P(5)=C5
305 FRIC_P(6)=C6
306C
307 IPARI(65) = INTKG
308C
309C------------------------------------------------------------
310C RENUMBERING OF FUNCTIONS AND SENSOR - USER TO INTERNAL ID
311C------------------------------------------------------------
312C
313 CALL INTER_DCOD_SENSOR (NTYP,NI,IPARI,NOM_OPT,SENSORS)
314C
315C------------------------------------------------------------
316C PRINTOUT
317C------------------------------------------------------------
318C
319 IF(IDSENS/=0) THEN
320 WRITE(IOUT,1505)IBC1,IBC2,IBC3,STFAC,GAP,IDSENS,IRM,PTMAX
321 ELSE
322 WRITE(IOUT,1516)IBC1,IBC2,IBC3,STFAC,GAP,STARTT,STOPT,IRM,PTMAX
323 ENDIF
324 WRITE(IOUT,4000)INACTI
325 IF(IDEL5/=0) THEN
326 WRITE(IOUT,'(a,a,i5/)')
327 . ' deletion flag on failure of main element',
328 . ' (1:yes-all/2:yes-any) set to ',IDEL5
329 IF(IDELKEEP == 1)THEN
330 WRITE(IOUT,'(a)')
331 . ' idel: DO not remove non-connected nodes from secondary surface'
332 ENDIF
333 ENDIF
334 WRITE(IOUT,1520)IFQ, XFILTR
335 IF(MFROT==0)THEN
336 WRITE(IOUT,1524) FRIC
337 ELSEIF(MFROT==1)THEN
338 WRITE(IOUT,1515)FRIC_P(1),FRIC_P(2),FRIC_P(3),
339 . FRIC_P(4),FRIC_P(5)
340 ELSEIF(MFROT==2)THEN
341 WRITE(IOUT,1522)FRIC,FRIC_P(1),FRIC_P(2),FRIC_P(3),
342 . FRIC_P(4),FRIC_P(5),FRIC_P(6)
343 ELSEIF(MFROT==3)THEN
344 WRITE(IOUT,1523)FRIC_P(1),FRIC_P(2),FRIC_P(3),
345 . FRIC_P(4),FRIC_P(5),FRIC_P(6)
346 ENDIF
347 IF(IBAG/=0) THEN
348 WRITE(IOUT,*)' airbag porosity coupling on '
349 ENDIF
350 IF(IADM/=0) THEN
351 WRITE(IOUT,*)' mesh refinement CASE of contact',
352 .' (0:no/1:due to curvature/2:due to curvature or penetration)',
353 .' set to ',IADM
354 IF(IADM==2)THEN
355 WRITE(IOUT,1557) NRADM,PADM,ANGLADM
356 END IF
357 ENDIF
358
359C--------------------------------------------------------------
360 IF(IS1==0)THEN
361 WRITE(IOUT,'(6x,a)')'no secondary surface input'
362 ELSEIF(IS1==1)THEN
363 WRITE(IOUT,'(6x,a)')'secondary surface input by segments'
364 ELSEIF(IS1==2)THEN
365 WRITE(IOUT,'(6x,a)')'secondary surface input by nodes'
366 ELSEIF(IS1==3)THEN
367 WRITE(IOUT,'(6x,a)')'secondary surface input by segments'
368 ELSEIF(IS1==4 )THEN
369 WRITE(IOUT,'(6x,a)')'secondary side input by bricks'
370 ELSEIF(IS1==5 )THEN
371 WRITE(IOUT,'(6x,a)')'secondary side input by solid elements'
372 ENDIF
373 IF(IS2==0)THEN
374 WRITE(IOUT,'(6x,a)')'no main surface input'
375 ELSEIF(IS2==1)THEN
376 WRITE(IOUT,'(6x,a)')'main surface input by segments'
377 ELSEIF(IS2==2)THEN
378 WRITE(IOUT,'(6x,a)')'main surface input by nodes'
379 ELSEIF(IS2==3)THEN
380 WRITE(IOUT,'(6x,a)')'main surface input by segments'
381 ELSEIF(IS2==4)THEN
382 WRITE(IOUT,'(6x,a)')'main surface refers ',
383 . 'to hyper-ellipsoidal surface'
384 ENDIF
385C
386C--------------------------------------------------------------
387 RETURN
388
389C------------
390 1505 FORMAT(//
391 . ' type==5 sliding and voids(non symmetric)' //,
392 . ' bound. cond. deleted after impact in x dir ',I1/,
393 . ' (1:yes 0:no) y dir ',I1/,
394 . ' z dir ',I1/,
395 . ' stiffness factor. . . . . . . . . . . . . . ',1PG20.13/,
396 . ' initial gap . . . . . . . . . . . . . . . . ',1PG20.13/,
397 . ' start time/stop time activated by sensor id ',I10/,
398 . ' main surface reordering flag. . . . . . . ',I1/,
399 . ' tangential pressure limit. . .. . . . . . . ',1PG20.13/)
400 1516 FORMAT(//
401 . ' type==5 sliding and voids(non symmetric)' //,
402 . ' bound. cond. deleted after impact in x dir ',I1/,
403 . ' (1:yes 0:no) y dir ',I1/,
404 . ' z dir ',I1/,
405 . ' stiffness factor. . . . . . . . . . . . . ',1PG20.13/,
406 . ' initial gap . . . . . . . . . . . . . . . ',1PG20.13/,
407 . ' start time. . . . . . . . . . . . . . . . ',1PG20.13/,
408 . ' stop time . . . . . . . . . . . . . . . . ',1PG20.13/,
409 . ' main surface reordering flag. . . . . . ',I1/,
410 . ' tangential pressure limit. . .. . . . . . ',1PG20.13/)
411C------------
412
413 1515 FORMAT(//
414 . ' friction model 1 (viscous polynomial)'/,
415 . ' mu = muo + c1 p + c2 v + c3 pv + c4 p^2 + c5 v^2'/,
416 . ' c1 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
417 . ' c2 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
418 . ' c3 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
419 . ' c4 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
420 . ' c5 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
421 . ' tangential pressure limit. . .. . . . . .',1PG20.13/)
422 1520 FORMAT(
423 . ' friction filtering flag. . . . . . . . . ',I10/,
424 . ' filtering factor . . . . . . . . . . . . ',1PG20.13)
425 1522 FORMAT(/
426 . ' friction model 2 (darmstad law) :'/,
427 . ' mu = muo+c1*exp(c2*v)*p^2+c3*exp(c4*v)*p+c5*exp(c6*v)'/,
428 . ' muo. . . . . . . . . . . . . . . . . . . ',1PG20.13/,
429 . ' c1 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
430 . ' c2 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
431 . ' c3 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
432 . ' c4 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
433 . ' c5 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
434 . ' c6 . . . . . . . . . . . . . . . . . . . ',1PG20.13/)
435 1523 FORMAT(/
436 . ' friction model 3 (renard law) :'/,
437 . ' c1 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
438 . ' c2 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
439 . ' c3 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
440 . ' c4 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
441 . ' c5 . . . . . . . . . . . . . . . . . . . ',1PG20.13/,
442 . ' c6 . . . . . . . . . . . . . . . . . . . ',1PG20.13/)
443 1524 FORMAT(/
444 . ' friction model 0 (coulomb law) :'/,
445 . ' friction coefficient . . . . . . . . . ',1PG20.13/)
446 1557 FORMAT(
447 .' number of elements within a 90 degrees fillet ',I5/,
448 .' --------------------------------------------- '/,
449 .' criteria for refinement due to penetration : '/,
450 .' ------------------------------------------ '/,
451 .' minimum percentage of penetration ',
452 . 1PG20.13/,
453 .' maximum angle on main side at contact location ',
454 . 1PG20.13//)
455
456 4000 FORMAT(
457 . ' de-activation of initial penetrations . . ',I10/)
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
id
initmumps id
Definition multiplerhs_example.m:4
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
groupdef_mod
Definition groupdef_mod.F:662
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841