OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type05.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!|| hm_read_inter_type05 ../starter/source/interfaces/int05/hm_read_inter_type05.f
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_struct ../starter/source/interfaces/reader/hm_read_inter_struct.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| inter_dcod_sensor ../starter/source/interfaces/reader/inter_dcod_sensor.F
32!|| ngr2usr ../starter/source/system/nintrr.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_inter_type05(
38 1 IPARI ,STFAC ,FRIGAP ,NOINT ,NI ,
39 2 IGRNOD ,IGRSURF ,NOM_OPT ,XFILTR ,FRIC_P ,
40 3 SENSORS ,UNITAB ,LSUBMODEL ,TITR ,NPARI ,
41 4 NPARIR )
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 IF (idel5>2.OR.n2d==1) idel5 = 0
223 ipari(17)=idel5
224
225 IF (ibag/=0.AND.nvolu==0.AND.ialelag==0.AND.nsphsol==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 IF (iadm/=0.AND.nadmesh==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 IF (xfiltr<0.OR.(ifq<=2.AND.xfiltr>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/)
458 END
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_read_inter_type05
subroutine hm_read_inter_type05(ipari, stfac, frigap, noint, ni, igrnod, igrsurf, nom_opt, xfiltr, fric_p, sensors, unitab, lsubmodel, titr, npari, nparir)
Definition hm_read_inter_type05.F:42
inter_dcod_sensor
subroutine inter_dcod_sensor(ntyp, ni, ipari, nom_opt, sensors)
Definition inter_dcod_sensor.F:40
max
#define max(a, b)
Definition macros.h:21
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
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
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723