OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type23.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_type23 ../starter/source/interfaces/int23/hm_read_inter_type23.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!|| ngr2usr ../starter/source/system/nintrr.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_read_inter_type23(
37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRSURF ,XFILTR ,FRIC_P ,NPC1 ,TITR ,
39 3 LSUBMODEL ,UNITAB ,NPARI ,NPARIR ,SNPC1 )
40C============================================================================
41C
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE groupdef_mod
47 USE submodel_mod , ONLY : nsubmod, submodel_data
48 USE unitab_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "scr06_c.inc"
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "units_c.inc"
61#include "scr12_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER,INTENT(IN) :: NPARI,NPARIR,SNPC1 !< array sizes
66 INTEGER ISU1,ISU2
67 INTEGER IPARI(NPARI),NPC1(SNPC1)
68 my_real stfac,xfiltr
69 my_real frigap(nparir),fric_p(10)
70 CHARACTER(LEN=NCHARTITLE) :: TITR
71 TYPE(submodel_data),INTENT(IN):: LSUBMODEL(NSUBMOD)
72 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
73C-----------------------------------------------
74 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,J,IBC1, IBC2, IBC3, IBUC, NOINT, NTYP,
79 . INACTI, IBC1M, IBC2M, IBC3M, IGSTI,IS1, IS2,
80 . ILEV, IGAP,MULTIMP,MFROT,IFQ,IBAG,MODFR, INTKG,
81 . idel23,ok,idelkeep,iadm,ifstf
82 my_real
83 . fric,gap,startt,bumult,stopt,c1,c2,c3,c4,c5,c6,alpha,
84 . gapscale,gapmax,stmin,stmax,visc,fpenmax,scal_t
85 INTEGER, DIMENSION(:), POINTER :: INGR2USR
86 LOGICAL IS_AVAILABLE
87C-----------------------------------------------
88C E x t e r n a l F u n c t i o n s
89C-----------------------------------------------
90 INTEGER NGR2USR
91C-----------------------------------------------
92C=======================================================================
93C READING PENALTY INTERFACE /INTER/TYPE23
94C=======================================================================
95
96C Initializations
97 is1=0
98 is2=0
99 ibc1=0
100 ibc2=0
101 ibc3=0
102 ibc1m=0
103 ibc2m=0
104 ibc3m=0
105 ibuc=0
106 mfrot=0
107 ifq=0
108 ibag=0
109 igsti = 0
110 ilev=0
111 idelkeep=0
112 intkg = 0
113 multimp = 0
114 ibag = 0
115 iadm=0
116 ifstf=0
117C
118 stopt=ep30
119 inacti = 0
120 fric = zero
121 gap = zero
122 gapscale = zero
123 startt = zero
124 visc = zero
125 xfiltr = zero
126 DO i = 1, 10
127 fric_p(i) = zero
128 ENDDO
129 c1=zero
130 c2=zero
131 c3=zero
132 c4=zero
133 c5=zero
134 c6=zero
135C
136 ntyp = 23
137 ipari(15)=noint
138 ipari(7)=ntyp
139
140 is_available = .false.
141C--------------------------------------------------
142C EXTRACT DATAS (INTEGER VALUES)
143C--------------------------------------------------
144 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
145 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
146 CALL hm_get_intv('type7_Istf',igsti,is_available,lsubmodel)
147 CALL hm_get_intv('Igap',igap,is_available,lsubmodel)
148 CALL hm_get_intv('Ibag',ibag,is_available,lsubmodel)
149 CALL hm_get_intv('Idel7',idel23,is_available,lsubmodel)
150 CALL hm_get_intv('INACTIV',inacti,is_available,lsubmodel)
151 CALL hm_get_intv('Ifric',mfrot,is_available,lsubmodel)
152 CALL hm_get_intv('Ifiltr',ifq,is_available,lsubmodel)
153 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
154 CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
155 CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
156C--------------------------------------------------
157C EXTRACT DATAS (REAL VALUES)
158C--------------------------------------------------
159 CALL hm_get_floatv('GAPSCALE',gapscale,is_available,lsubmodel,unitab)
160 CALL hm_get_floatv('GAPMAX',gapmax,is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('FpenMax',fpenmax,is_available,lsubmodel,unitab)
162 CALL hm_get_floatv('STMIN',stmin,is_available,lsubmodel,unitab)
163 CALL hm_get_floatv('STMAX',stmax,is_available,lsubmodel,unitab)
164 CALL hm_get_floatv('TYPE7_SCALE',stfac,is_available,lsubmodel,unitab)
165 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
166 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
167 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
168 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
169 CALL hm_get_floatv('STIFF_DC',visc,is_available,lsubmodel,unitab)
170 CALL hm_get_floatv('SORT_FACT',bumult,is_available,lsubmodel,unitab)
171 CALL hm_get_floatv('Xfreq',alpha,is_available,lsubmodel,unitab)
172 CALL hm_get_floatv('C1',c1,is_available,lsubmodel,unitab)
173 CALL hm_get_floatv('C2',c2,is_available,lsubmodel,unitab)
174 CALL hm_get_floatv('C3',c3,is_available,lsubmodel,unitab)
175 CALL hm_get_floatv('C4',c4,is_available,lsubmodel,unitab)
176 CALL hm_get_floatv('C5',c5,is_available,lsubmodel,unitab)
177 CALL hm_get_floatv('C6',c6,is_available,lsubmodel,unitab)
178C
179C....* CHECKS And Storage IPARI FRIGAP *.............
180
181 IF (idel23 < 0) THEN
182 idelkeep=1
183 idel23=abs(idel23)
184 END IF
185 ipari(61)=idelkeep
186
187 IF (idel23>2.OR.n2d==1) idel23 = 0
188 ipari(17)=idel23
189
190 is1=1
191 ingr2usr => igrsurf(1:nsurf)%ID
192 isu1=ngr2usr(isu1,ingr2usr,nsurf)
193 is2=1
194 isu2=ngr2usr(isu2,ingr2usr,nsurf)
195
196 ipari(34)=igsti
197
198 IF (ibag/=0.AND.nvolu==0 .AND. ialelag == 0) THEN
199 CALL ancmsg(msgid=614,
200 . msgtype=msgwarning,
201 . anmode=aninfo_blind_2,
202 . i1=noint,
203 . c1=titr)
204 ibag=0
205 ENDIF
206C.......* *........
207 ipari(45)=isu1
208 ipari(46)=isu2
209 ipari(13)=is1*10+is2
210 ipari(21)=igap
211 intbag = max(intbag,ibag)
212 kcontact =max(kcontact,ibag,iadm)
213 ipari(32) = ibag
214
215 IF(multimp==0)THEN
216 multimp=12
217 END IF
218 ipari(23)=multimp
219C
220 frigap(16) = gapmax
221 IF(gapscale==zero.OR.igap==0)gapscale=one
222 frigap(19) = gapscale
223 IF (fpenmax == zero) fpenmax = one
224 frigap(27) = fpenmax
225C
226
227 IF(stmax==zero)stmax=ep30
228 frigap(17) = stmin
229 frigap(18) = stmax
230 IF(igsti==0)i7stifs=1
231 ipari(48) =ifstf ! IFSTF is not read anymore
232 scal_t=one ! SCAL_T is not read anymore
233 frigap(33)=scal_t
234C
235 IF(stfac==zero) THEN
236 stfac=one
237 ENDIF
238 IF(igsti==1)stfac=-stfac
239 IF (stopt == zero) stopt = ep30
240C
241 frigap(1)=fric
242 frigap(2)=gap
243 frigap(3)=startt
244 frigap(11)=stopt
245C
246 IF(visc==zero) visc=one
247C
248 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
249 ipari(22)=inacti
250 frigap(14)=visc
251
252C BUMULT is increased for big models
253 IF(bumult==zero) bumult = bmul0
254
255 frigap(4)=bumult
256C
257 IF (alpha==0.) ifq = 0
258C
259 modfr=2
260 ifq = ifq + 10
261
262 IF (ifq>0) THEN
263 IF (ifq==10) xfiltr = one
264 IF (mod(ifq,10)==1) xfiltr = alpha
265 IF (mod(ifq,10)==2) xfiltr=four*atan2(one,zero) / alpha
266 IF (mod(ifq,10)==3) xfiltr=four*atan2(one,zero) * alpha
267 IF (xfiltr<zero) THEN
268 CALL ancmsg(msgid=554,
269 . msgtype=msgerror,
270 . anmode=aninfo_blind_1,
271 . i1=noint,
272 . c1=titr,
273 . r1=alpha)
274 ELSEIF (xfiltr>1.AND.mod(ifq,10)<=2) THEN
275 CALL ancmsg(msgid=554,
276 . msgtype=msgerror,
277 . anmode=aninfo_blind_1,
278 . i1=noint,
279 . c1=titr,
280 . r1=alpha)
281 ENDIF
282 ELSE
283 xfiltr = zero
284 ENDIF
285C
286 ipari(30) = mfrot
287 ipari(31) = ifq
288C
289 fric_p(1) = c1
290 fric_p(2) = c2
291 fric_p(3) = c3
292 fric_p(4) = c4
293 fric_p(5) = c5
294 fric_p(6) = c6
295C
296 ipari(65)=intkg
297 ipari(20)=ilev
298 ipari(12)=ibuc
299
300C FRIGAP(10) is initialized but used only in engine for storing number of couples candidates
301 frigap(10)=float(0)
302C
303C------------------------------------------------------------
304C RENUMBERING OF FUNCTIONS USER TO INTERNAL ID
305C------------------------------------------------------------
306C
307 IF (ipari(48) /= 0) THEN
308 ok = 0
309 DO j=1,nfunct
310 IF (ipari(48) == npc1(j)) THEN
311 ipari(48)=j
312 ok = 1
313 EXIT
314 ENDIF
315 ENDDO
316 IF(ok == 1) THEN
317 CALL ancmsg(msgid=121,
318 . msgtype=msgerror,
319 . anmode=aninfo_blind_1,
320 . i1=noint,
321 . c1=titr,
322 . i2=ipari(48))
323 ENDIF
324 ENDIF
325C
326C------------------------------------------------------------
327C PRINTOUT
328C------------------------------------------------------------
329C
330 WRITE(iout,2301)ibc1,ibc2,ibc3,ibc1m,ibc2m,ibc3m,
331 . igsti,stfac,ifstf,scal_t,stmin,stmax,
332 . fric,igap,gap,gapmax,gapscale,startt,stopt,
333 . bumult,inacti,visc,multimp,ibag
334 WRITE(iout,1520)mod(ifq,10), 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 ELSEIF(mfrot==4)THEN
347 WRITE(iout,1526) fric,fric_p(1),fric_p(2)
348 ENDIF
349 IF(idel23/=0) THEN
350 WRITE(iout,'(A,I5/)')
351 . ' DELETION FLAG ON FAILURE (1:YES) : ',idel23
352 IF(idelkeep == 1)THEN
353 WRITE(iout,'(A)')
354 . ' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
355 ENDIF
356 ENDIF
357
358C--------------------------------------------------------------
359 IF(is1==0)THEN
360 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
361 ELSEIF(is1==1)THEN
362 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
363 ELSEIF(is1==2)THEN
364 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
365 ELSEIF(is1==3)THEN
366 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
367 ELSEIF(is1==4 )THEN
368 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
369 ELSEIF(is1==5 )THEN
370 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
371 ENDIF
372 IF(is2==0)THEN
373 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
374 ELSEIF(is2==1)THEN
375 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
376 ELSEIF(is2==2)THEN
377 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
378 ELSEIF(is2==3)THEN
379 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
380 ELSEIF(is2==4)THEN
381 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
382 . 'TO HYPER-ELLIPSOIDAL SURFACE'
383 ENDIF
384C
385C--------------------------------------------------------------
386C------------
387 RETURN
388
389
390 1515 FORMAT(//
391 . ' FRICTION MODEL 1 (Viscous Polynomial)'/,
392 . ' MU = MUo + C1 p + C2 v + C3 pv + C4 p^2 + C5 v^2'/,
393 . ' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
394 . ' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
395 . ' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
396 . ' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
397 . ' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
398 . ' TANGENTIAL PRESSURE LIMIT. . .. . . . . .',1pg20.13/)
399 1522 FORMAT(/
400 . ' FRICTION MODEL 2 (Darmstad Law) :'/,
401 . ' MU = MUo+c1*exp(c2*v)*p^2+c3*exp(c4*v)*p+c5*exp(c6*v)'/,
402 . ' Muo. . . . . . . . . . . . . . . . . . . ',1pg20.13/,
403 . ' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
404 . ' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
405 . ' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
406 . ' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
407 . ' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
408 . ' C6 . . . . . . . . . . . . . . . . . . . ',1pg20.13/)
409 1523 FORMAT(/
410 . ' FRICTION MODEL 3 (Renard law) :'/,
411 . ' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
412 . ' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
413 . ' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
414 . ' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
415 . ' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
416 . ' C6 . . . . . . . . . . . . . . . . . . . ',1pg20.13/)
417 1524 FORMAT(/
418 . ' FRICTION MODEL 0 (Coulomb Law) :'/,
419 . ' FRICTION COEFFICIENT . . . . . . . . . ',1pg20.13/)
420
421 1526 FORMAT(/
422 . ' EXPONENTIAL DECAY FRICTION LAW '/
423 . ' MU = c1+(MUo-c1)*exp(-c2*v)'/
424 . ' STATIC COEFFICIENT MUo . . . . . . . . . ',1pg20.13/,
425 . ' DYNAMIC COEFFICIENT C1 . . . . . . . . . ',1pg20.13/,
426 . ' EXPONENTIAL DECAY COEFFICIENT C2 . . . . ',1pg20.13/)
427
428 1520 FORMAT(
429 . ' FRICTION FILTERING FLAG. . . . . . . . . ',i10/,
430 . ' FILTERING FACTOR . . . . . . . . . . . . ',1pg20.13)
431C----------
432 2301 FORMAT(//
433 . ' TYPE==23 PARALLEL/AUTO IMPACTING ' //,
434 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
435 . ' SECONDARY NODE (1:YES 0:NO) Y DIR ',i1/,
436 . ' Z DIR ',i1/,
437 . ' bound. cond. deleted after impact in x dir ',I1/,
438 . ' main node(1:yes 0:no) y dir ',I1/,
439 . ' z dir ',I1/,
440 . ' stiffness formulation. . . . . . . . . . ',I1/,
441 .' 0 : stiffness is computed from stiffness on secondary side'/,
442 .' 1 : stfac is a stiffness VALUE '/,
443 . ' stiffness factor or stiffness VALUE . . . ',1PG20.13/,
444 . ' ifstf:FUNCTION id for stiffness factor vs time. ',I10/,
445 . ' scale factor on abscissa for function ifstf . . ',1PG20.13/,
446 . ' minimum stiffness. . . . . . . . . . . . ',1PG20.13/,
447 . ' maximum stiffness. . . . . . . . . . . . ',1PG20.13/,
448 . ' friction factor . . . . . . . . . . . . . ',1PG20.13/,
449 . ' variable gap flag . . . . . . . . . . . . ',I5/,
450 . ' minimum gap . . . . . . . . . . . . . . . ',1PG20.13/,
451 . ' maximum gap (= 0. <=> NO MAXIMUM GAP) . . ',1PG20.13/,
452 . ' gap scale factor. . . . . . . . . . . . . ',1PG20.13/,
453 . ' start time. . . . . . . . . . . . . . . . ',1PG20.13/,
454 . ' stop time . . . . . . . . . . . . . . . . ',1PG20.13/,
455 . ' bucket factor . . . . . . . . . . . . . . ',1PG20.13/,
456 . ' de-activation of initial penetrations . . ',I10/,
457 . ' critical damping factor . . . . . . . . . ',1PG20.13/,
458 . ' mean possible number of impact/node . . . ',I5/,
459 . ' ibag . . . . . . . . . . . . . . . . . . ',I5/)
460 END
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
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
hm_read_inter_type23
subroutine hm_read_inter_type23(ipari, stfac, frigap, noint, igrsurf, xfiltr, fric_p, npc1, titr, lsubmodel, unitab, npari, nparir, snpc1)
Definition hm_read_inter_type23.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: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
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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:895
submodel_mod::submodel_data
Definition submodel_mod.F:728