OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type06.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type06 (ipari, stfac, frigap, noint, igrsurf, npc1, titr, lsubmodel, unitab)

Function/Subroutine Documentation

◆ hm_read_inter_type06()

subroutine hm_read_inter_type06 ( integer, dimension(*) ipari,
stfac,
frigap,
integer noint,
type (surf_), dimension(nsurf), target igrsurf,
integer, dimension(*) npc1,
character(len=nchartitle) titr,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (unit_type_), intent(in) unitab )

Definition at line 36 of file hm_read_inter_type06.F.

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.AND. IF (HFLAG > 0 IFUN2 == 0) HFLAG = 2
183.AND. IF (HFLAG > 0 STIFF == ZERO) HFLAG = 0
184.AND. IF (HFLAG == 0 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.AND. IF (IPARI(47) > 0 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/)
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_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
id
initmumps id
Definition multiplerhs_example.m:4
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
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33