OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type06.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_type06 ../starter/source/interfaces/int06/hm_read_inter_type06.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_type06(
37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRSURF ,NPC1 ,TITR ,LSUBMODEL ,UNITAB )
39C============================================================================
40C
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 USE groupdef_mod
46 USE submodel_mod
47 USE unitab_mod
48 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ISU1,ISU2,NOINT
60 INTEGER IPARI(*),NPC1(*)
61 my_real
62 . stfac
63 my_real
64 . frigap(*)
65 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
66 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
67 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
68C-----------------------------------------------
69 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com04_c.inc"
74#include "units_c.inc"
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,J,L, NTYP, IBID,INACTI,IS1, IS2,ILEV,NCURS,NLO,
79 . NFRIC, NDAMP1,NDAMP2,IRS,IRM,IFUN1,IFUN2,HFLAG,IKK,II,
80 . intkg, nfric1,nfric2,icor,ierr1,ierr2,ifric1,ifric2,
81 . idamp1,idamp2,igsti
82 my_real
83 . fac,fac1,fac2,fac3,facf,facv,fric,gap,startt,stopt,sfric,
84 . visc,facx,stiff
85 CHARACTER(LEN=40)::MESS
86 CHARACTER(LEN=NCHARTITLE)::MSGTITL
87 CHARACTER(LEN=NCHARKEY)::OPT,KEY,KEY1
88 CHARACTER(LEN=NCHARFIELD)::BCFLAG,BCFLAGM
89!
90 INTEGER, DIMENSION(:), POINTER :: INGR2USR
91 LOGICAL IS_AVAILABLE
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95 INTEGER NGR2USR
96C=======================================================================
97C READING PENALTY INTERFACE /INTER/TYPE6
98C=======================================================================
99C Initializations
100 is1=0
101 is2=0
102 ifun1=0
103 ifun2=0
104 igsti = 0
105 inacti = 0
106 ilev = 0
107 intkg = 0
108C
109 fric = zero
110 gap = zero
111 startt = zero
112 stopt=ep30
113 visc = zero
114 facx = zero
115C
116 ntyp = 6
117 ipari(15)=noint
118 ipari(7)=ntyp
119C
120 is_available = .false.
121C--------------------------------------------------
122C EXTRACT DATAS (INTEGER VALUES)
123C--------------------------------------------------
124 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
125 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
126
127 CALL hm_get_intv('Gflag',irs,is_available,lsubmodel)
128 CALL hm_get_intv('Vflag',irm,is_available,lsubmodel)
129 CALL hm_get_intv('INACTIV',inacti,is_available,lsubmodel)
130 CALL hm_get_intv('Crx_Fun',nfric1,is_available,lsubmodel)
131 CALL hm_get_intv('Cry_Fun',nfric2,is_available,lsubmodel)
132
133 CALL hm_get_intv('FUN_A1',ifun1,is_available,lsubmodel)
134 CALL hm_get_intv('HFLAG1',hflag,is_available,lsubmodel)
135 CALL hm_get_intv('ISFLAG',icor,is_available,lsubmodel)
136
137 CALL hm_get_intv('FUNCT_ID',ifun2,is_available,lsubmodel)
138 CALL hm_get_intv('Crz_Fun',ndamp2,is_available,lsubmodel)
139 CALL hm_get_intv('Ctx_Fun',ndamp1,is_available,lsubmodel)
140C--------------------------------------------------
141C EXTRACT DATAS (REAL VALUES)
142C--------------------------------------------------
143 CALL hm_get_floatv('Friction_phi',sfric,is_available,lsubmodel,unitab)
144 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
145 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
148
149 CALL hm_get_floatv('scale1',facf,is_available,lsubmodel,unitab)
150 CALL hm_get_floatv('scale2',facv,is_available,lsubmodel,unitab)
151
152 CALL hm_get_floatv('FACX',facx,is_available,lsubmodel,unitab)
153 CALL hm_get_floatv('FAC',fac1,is_available,lsubmodel,unitab)
154
155 CALL hm_get_floatv('STIFF1',stiff,is_available,lsubmodel,unitab)
156 CALL hm_get_floatv('PFscale',fac2,is_available,lsubmodel,unitab)
157 CALL hm_get_floatv('VISC',visc,is_available,lsubmodel,unitab)
158 CALL hm_get_floatv('scale3',fac3,is_available,lsubmodel,unitab)
159
160C....* CHECKS *.............
161
162 is1=1
163 is2=1
164 ingr2usr => igrsurf(1:nsurf)%ID
165 isu1=ngr2usr(isu1,ingr2usr,nsurf)
166 isu2=ngr2usr(isu2,ingr2usr,nsurf)
167
168C.......* Storage IPARI FRIGAP *........
169 ipari(45)=isu1
170 ipari(46)=isu2
171 ipari(13)=is1*10+is2
172 IF (stopt == zero) stopt = ep30
173
174C.....* Storage IPARI FRIGAP *.......
175 frigap(1)=fric
176 frigap(2)=gap
177 frigap(3)=startt
178 frigap(11)=stopt
179
180C....* CHECKS *.............
181
182 IF (hflag > 0 .AND. ifun2 == 0) hflag = 2
183 IF (hflag > 0 .AND. stiff == zero) hflag = 0
184 IF (hflag == 0 .AND. icor == 1) icor = 0
185 IF (facx == zero) facx = one
186 IF (fac1 == zero) fac1 = one
187 IF (fac2 == zero) fac2 = one
188 IF (fac3 == zero) fac3 = one
189 IF (facf == zero) facf = one
190 IF (facv == zero) facv = one
191 IF (stiff == zero) stiff = ep30
192 facx = one / facx
193 facf = one / facf
194 facv = one / facv
195C
196C.....* Storage IPARI FRIGAP *.......
197 stfac = fac1
198 IF (stfac == zero) stfac = one_fifth
199 ipari(11) = ifun1
200 ipari(22) = inacti
201 ipari(24) = irm
202 ipari(25) = irs
203 ipari(47) = hflag
204 ipari(49) = ifun2
205 ipari(51) = nfric1
206 ipari(52) = ndamp1
207 ipari(53) = ndamp2
208 ipari(54) = nfric2
209 ipari(58) = icor
210 ipari(20) = ilev
211 ipari(65) = intkg
212 frigap(5) = sfric
213 frigap(19) = facx
214 frigap(20) = fac2
215 frigap(21) = stiff
216 frigap(22) = facf
217 frigap(23) = facv
218 frigap(24) = fac3
219 frigap(14)=visc
220C
221C------------------------------------------------------------
222C RENUMBERING OF FUNCTIONS - USER TO INTERNAL ID
223C------------------------------------------------------------
224 ierr1 = 1
225 DO j=1,nfunct
226 IF (ipari(11) == npc1(j)) THEN
227 ipari(11)=j
228 ierr1 = 0
229 EXIT
230 ENDIF
231 ENDDO
232 IF (ierr1 == 1) THEN
233 CALL ancmsg(msgid=121,
234 . msgtype=msgerror,
235 . anmode=aninfo_blind_1,
236 . i1=noint,
237 . c1=titr,
238 . i2=ipari(11))
239 ENDIF
240c
241 IF (ipari(47) > 0 .AND. ipari(49) /= 0) THEN
242 ierr2 = 1
243 DO j=1,nfunct
244 IF(ipari(49) == npc1(j)) THEN
245 ipari(49)=j
246 ierr2 = 0
247 EXIT
248 ENDIF
249 ENDDO
250 IF (ierr2 == 1) THEN
251 CALL ancmsg(msgid=121,
252 . msgtype=msgerror,
253 . anmode=aninfo_blind_1,
254 . i1=noint,
255 . c1=titr,
256 . i2=ipari(49))
257 ENDIF
258 ENDIF
259c
260 ifric1 = ipari(51)
261 IF (ifric1 /= 0) THEN ! friction coefficient = f(Fn)
262 ierr1 = 1
263 DO j=1,nfunct
264 IF (ifric1 == npc1(j)) THEN
265 ipari(51) = j
266 ierr1 = 0
267 EXIT
268 ENDIF
269 ENDDO
270 IF (ierr1 == 1) CALL ancmsg(msgid=113,
271 . msgtype=msgerror,
272 . anmode=aninfo,
273 . i1=noint,
274 . c1=titr,
275 . i2=ifric1)
276 ENDIF
277c
278 idamp1 = ipari(52)
279 IF (idamp1 /= 0) THEN ! damping coefficient = f(Fn)
280 ierr1 = 1
281 DO j=1,nfunct
282 IF (idamp1 == npc1(j)) THEN
283 ipari(52) = j
284 ierr1 = 0
285 EXIT
286 ENDIF
287 ENDDO
288 IF (ierr1 == 1) CALL ancmsg(msgid=113,
289 . msgtype=msgerror,
290 . anmode=aninfo,
291 . i1=noint,
292 . c1=titr,
293 . i2=idamp1)
294 ENDIF
295c
296 idamp2 = ipari(53)
297 IF (idamp2 /= 0) THEN ! damping coefficient = f(Vn)
298 ierr1 = 1
299 DO j=1,nfunct
300 IF (idamp2 == npc1(j)) THEN
301 ipari(53) = j
302 ierr1 = 0
303 EXIT
304 ENDIF
305 ENDDO
306 IF (ierr1 == 1) CALL ancmsg(msgid=113,
307 . msgtype=msgerror,
308 . anmode=aninfo,
309 . i1=noint,
310 . c1=titr,
311 . i2=idamp2)
312 ENDIF
313c
314 ifric2 = ipari(54)
315 IF (ifric2 /= 0) THEN ! friction coefficient = f(Vn)
316 ierr1 = 1
317 DO j=1,nfunct
318 IF (ifric2 == npc1(j)) THEN
319 ipari(54) = j
320 ierr1 = 0
321 EXIT
322 ENDIF
323 ENDDO
324 IF (ierr1 == 1) CALL ancmsg(msgid=113,
325 . msgtype=msgerror,
326 . anmode=aninfo,
327 . i1=noint,
328 . c1=titr,
329 . i2=ifric2)
330 ENDIF
331C
332C------------------------------------------------------------
333C PRINTOUT
334C------------------------------------------------------------
335 WRITE(iout,1506) hflag,icor,ifun1,ifun2,facx,stfac,fac2,
336 . stiff,sfric,fric,nfric1,nfric2,visc,
337 . ndamp2,ndamp1,inacti,gap,startt,stopt,irs,irm
338C--------------------------------------------------------------
339 IF(is1==0)THEN
340 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
341 ELSEIF(is1==1)THEN
342 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
343 ELSEIF(is1==2)THEN
344 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
345 ELSEIF(is1==3)THEN
346 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
347 ELSEIF(is1==4 )THEN
348 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
349 ELSEIF(is1==5 )THEN
350 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
351 ENDIF
352 IF(is2==0)THEN
353 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
354 ELSEIF(is2==1)THEN
355 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
356 ELSEIF(is2==2)THEN
357 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
358 ELSEIF(is2==3)THEN
359 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
360 ELSEIF(is2==4)THEN
361 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
362 . 'TO HYPER-ELLIPSOIDAL SURFACE'
363 ENDIF
364C
365C--------------------------------------------------------------
366 1000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
367 1300 FORMAT( /1x,' INTERFACES ' /
368 . 1x,' -------------- '// )
369C------------
370 RETURN
371
372 1506 FORMAT(//
373 . ' TYPE==6 RIGID BODY INTERFACE ' //,
374 . ' FORMULATION FLAG . . . . ',i10/,
375 . ' INITIAL PENETRATION FLAG . . . . ',i10/,
376 . ' LOADING FUNCTION ID . . . . ',i10/,
377 . ' UNLOADING FUNCTION ID . . . . ',i10/,
378 . ' ABSCISSA (DISPLACEMENT) SCALE FACTOR. . . ',1pg20.13/,
379 . ' LOAD FUNCTION SCALE FACTOR . . . . . . . ',1pg20.13/,
380 . ' UNLOAD FUNCTION SCALE FACTOR . . . . . . ',1pg20.13/,
381 . ' ELASTIC MODULUS . . . . . . . . . . . . . ',1pg20.13/,
382 . ' STATIC FRICTION FORCE . . . . . . . . . . ',1pg20.13/,
383 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
384 . ' FRICTION FUNCTION OF NORMAL FORCE . . . . .',i10/,
385 . ' friction FUNCTION of slip velocity. . . . .',I10/,
386 . ' damping coefficient . . . . . . . . . . . ',1PG20.13/,
387 . ' damping amplifier function vs normal force.',I10/,
388 . ' damping force function vs velocity. . . . .',I10/,
389 . ' de-activation of initial penetrations . . .',I10/,
390 . ' initial gap . . . . . . . . . . . . . . . ',1PG20.13/,
391 . ' start time. . . . . . . . . . . . . . . . ',1PG20.13/,
392 . ' stop time . . . . . . . . . . . . . . . . ',1PG20.13/,
393 . ' secondary surface reordering flag . . . . . . ',I1/,
394 . ' main surface reordering flag. . . . . . ',I1/)
395 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
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_type06
subroutine hm_read_inter_type06(ipari, stfac, frigap, noint, igrsurf, npc1, titr, lsubmodel, unitab)
Definition hm_read_inter_type06.F:39
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
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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