OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type20.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_type20 ../starter/source/interfaces/int20/hm_read_inter_type20.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!||====================================================================
37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRNOD ,IGRSURF ,IGRSLIN ,XFILTR ,FRIC_P ,
39 3 UNITAB ,LSUBMODEL ,TITR )
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
89 my_real
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 IF (isu1 == 0 .AND. isu2 == 0) iedge = -1
257 ipari(58)=iedge
258
259 IF(iedge==3 .and. 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 IF(line2 == 0 .and. 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 IF(line1 == line2 .and. 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 IF (idel7n>2.OR.n2d==1) idel7n = 0
305 ipari(17)=idel7n
306
307 IF (ibag/=0.AND.nvolu==0 .AND. 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 IF(stfac==zero.AND.igsti/=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 IF(fric/=zero.AND.viscf==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 IF (mfrot/=0.AND.viscf==0.0) viscf=one
392
393 IF (alpha==0.) ifq = 0
394
395 IF (modfr==0) modfr = 2
396 IF (modfr==2.AND.ifq<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 ELSEIF (xfiltr>1.AND.mod(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
552 END
#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)
subroutine hm_read_inter_type20(ipari, stfac, frigap, noint, igrnod, igrsurf, igrslin, xfiltr, fric_p, unitab, lsubmodel, titr)
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
integer, parameter ncharkey
integer, parameter ncharfield
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