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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type08 (ipari, stfac, frigap, noint, igrnod, igrsurf, unitab, lsubmodel, titr)

Function/Subroutine Documentation

◆ hm_read_inter_type08()

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

Definition at line 36 of file hm_read_inter_type08.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
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(*)
61 my_real
62 . stfac
63 my_real
64 . frigap(*)
65 CHARACTER(LEN=NCHARTITLE) :: TITR
66C-----------------------------------------------
67 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
68 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
69 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
70 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "units_c.inc"
77#include "remesh_c.inc"
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER NTYP,IS1, IS2,IFT0,IFORM,IRM
82 my_real
83 . fric,startt,stopt,fnor,dbdepth,visc,
84 . fric_last,fnor_last
85
86!
87 INTEGER, DIMENSION(:), POINTER :: INGR2USR
88C-----------------------------------------------
89C E x t e r n a l F u n c t i o n s
90C-----------------------------------------------
91 INTEGER NGR2USR
92 LOGICAL IS_AVAILABLE
93C-----------------------------------------------
94C=======================================================================
95C READING Drawbead INTERFACE /INTER/TYPE8
96C=======================================================================
97
98C Initializations
99 is1=0
100 is2=0
101 iform = 0
102 ift0 = 0
103 irm = 0
104C
105 fric = zero
106 startt = zero
107 stopt=ep30
108 fnor = zero
109 dbdepth =zero
110 visc = zero
111 fric_last = zero
112 fnor_last = zero
113C
114 ntyp = 8
115 ipari(15)=noint
116 ipari(7)=ntyp
117C
118 is_available = .false.
119C--------------------------------------------------
120C EXTRACT DATAS (INTEGER VALUES)
121C--------------------------------------------------
122C
123 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
124 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
125 CALL hm_get_intv('IFORM1',iform,is_available,lsubmodel)
126C
127C--------------------------------------------------
128C EXTRACT DATAS (REAL VALUES)
129C--------------------------------------------------
130
131 CALL hm_get_floatv('MU',fnor,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv('DBEAD_FORCE',fric,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv('PEXT',dbdepth,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv('MU_LAST',fnor_last,is_available,lsubmodel,unitab)
137 CALL hm_get_floatv('DBEAD_FORCE_LAST',fric_last,is_available,lsubmodel,unitab)
138
139C
140C--------------------------------------------------
141C CHECKS And Storage IPARI FRIGAP
142C--------------------------------------------------
143C
144
145C
146C....* Card1 :flags *.............
147
148 is1=2
149 is2=1
150 IF(iform==0)iform=2
151 IF(iform==1.AND.istatcnd/=0)THEN
152 CALL ancmsg(msgid=703,
153 . msgtype=msgerror,
154 . anmode=aninfo,
155 . i1=noint,
156 . c1=titr)
157 END IF
158
159 ipari(48) = iform
160
161 ingr2usr => igrnod(1:ngrnod)%ID
162 isu1=ngr2usr(isu1,ingr2usr,ngrnod)
163 IF(igrnod(isu1)%SORTED/=1)THEN
164 CALL ancmsg(msgid=112,
165 . msgtype=msgerror,
166 . anmode=aninfo,
167 . i1=noint,
168 . c1=titr)
169 ENDIF
170 ingr2usr => igrsurf(1:nsurf)%ID
171 isu2=ngr2usr(isu2,ingr2usr,nsurf)
172
173C.......* Storage IPARI FRIGAP *........
174 ipari(45)=isu1
175 ipari(46)=isu2
176 ipari(13)=is1*10+is2
177
178C
179C....* Card1 :flags *.............
180
181 IF (stopt == zero) stopt = ep30
182
183C.....* Storage IPARI FRIGAP *.......
184 frigap(1)=fric
185 frigap(3)=startt
186 frigap(11)=stopt
187 frigap(4)=fnor
188 frigap(5)=dbdepth
189 frigap(6)=fric_last
190 frigap(7)=fnor_last
191 IF(fric_last/= zero.OR.fnor_last/= zero) ipari(49) = 1 ! flag to activate linear force computation
192C------------------------------------------------------------
193
194 IF(iform==2) THEN
195C VISC is a non documented parameter
196 IF(visc==zero) visc=em01
197 END IF
198
199 IF(nadmesh/=0) kcontact=1
200
201 frigap(14)=visc
202
203 IF (stfac == zero ) stfac = one_fifth
204C
205C------------------------------------------------------------
206C PRINTOUT
207C------------------------------------------------------------
208C
209 IF(fnor_last==zero.AND.fric_last==zero) THEN
210 WRITE(iout,1508)fric,fnor,dbdepth,startt,stopt,irm,iform,ift0
211 ELSEIF(fnor_last==zero) THEN
212 WRITE(iout,1509)fric,fric_last,fnor,dbdepth,startt,stopt,irm,iform,ift0
213 ELSEIF(fric_last==zero) THEN
214 WRITE(iout,1510)fric,fnor,fnor_last,dbdepth,startt,stopt,irm,iform,ift0
215 ELSE
216 WRITE(iout,1511)fric,fric_last,fnor,fnor_last,dbdepth,startt,stopt,irm,iform,ift0
217 ENDIF
218
219C--------------------------------------------------------------
220 IF(is1==0)THEN
221 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
222 ELSEIF(is1==1)THEN
223 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
224 ELSEIF(is1==2)THEN
225 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
226 ELSEIF(is1==3)THEN
227 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
228 ELSEIF(is1==4 )THEN
229 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
230 ELSEIF(is1==5 )THEN
231 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
232 ENDIF
233 IF(is2==0)THEN
234 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
235 ELSEIF(is2==1)THEN
236 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
237 ELSEIF(is2==2)THEN
238 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
239 ELSEIF(is2==3)THEN
240 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
241 ELSEIF(is2==4)THEN
242 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
243 . 'TO HYPER-ELLIPSOIDAL SURFACE'
244 ENDIF
245C
246C--------------------------------------------------------------
247C------------
248 RETURN
249
250 1508 FORMAT(//
251 . ' TYPE==8 DRAW-BEAD ' //,
252 . ' RETRAINING DRAW-BEAD FORCE / UNIT LENGTH . ',1pg20.13/,
253 . ' NORMAL DRAW-BEAD FORCE / UNIT LENGTH . . . ',1pg20.13/,
254 . ' DRAW-BEAD DEPTH . . . . . . . . . . . . . ',1pg20.13/,
255 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
256 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
257 . ' MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
258 . ' FORMULATION FOR TANGENTIAL FORCE COMPUTATION',/,
259 . ' (1: VISCOUS, 2: INCREMENTAL) . . .',i1/,
260 . ' DEACTIVATION FLAG FOR RETRAINING FORCE REDUCING',i1/)
261 1509 FORMAT(//
262 . ' TYPE==8 DRAW-BEAD ' //,
263 . ' RETRAINING DRAW-BEAD FORCE / UNIT LENGTH . ',/,
264 . ' AT THE FIRST NODE. . . . . . . ',1pg20.13/,
265 . ' RETRAINING DRAW-BEAD FORCE / UNIT LENGTH . ',/,
266 . ' AT THE LAST NODE . . . . . . . ',1pg20.13/,
267 . ' NORMAL DRAW-BEAD FORCE / UNIT LENGTH . . . ',1pg20.13/,
268 . ' DRAW-BEAD DEPTH . . . . . . . . . . . . . ',1pg20.13/,
269 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
270 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
271 . ' MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
272 . ' FORMULATION FOR TANGENTIAL FORCE COMPUTATION',/,
273 . ' (1: VISCOUS, 2: INCREMENTAL) . . .',i1/,
274 . ' DEACTIVATION FLAG FOR RETRAINING FORCE REDUCING',i1/)
275 1510 FORMAT(//
276 . ' TYPE==8 DRAW-BEAD ' //,
277 . ' RETRAINING DRAW-BEAD FORCE / UNIT LENGTH . ',1pg20.13/,
278 . ' NORMAL DRAW-BEAD FORCE / UNIT LENGTH . . . ',/,
279 . ' AT THE FIRST NODE. . . . . . . ',1pg20.13/,
280 . ' NORMAL DRAW-BEAD FORCE / UNIT LENGTH . . . ',/,
281 . ' AT THE LAST NODE . . . . . . . ',1pg20.13/,
282 . ' DRAW-BEAD DEPTH . . . . . . . . . . . . . ',1pg20.13/,
283 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
284 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
285 . ' MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
286 . ' FORMULATION FOR TANGENTIAL FORCE COMPUTATION',/,
287 . ' (1: VISCOUS, 2: INCREMENTAL) . . .',i1/,
288 . ' DEACTIVATION FLAG FOR RETRAINING FORCE REDUCING',i1/)
289 1511 FORMAT(//
290 . ' TYPE==8 DRAW-BEAD ' //,
291 . ' RETRAINING DRAW-BEAD FORCE / UNIT LENGTH . ',/,
292 . ' AT THE FIRST NODE. . . . . . . ',1pg20.13/,
293 . ' RETRAINING DRAW-BEAD FORCE / UNIT LENGTH . ',/,
294 . ' AT THE LAST NODE . . . . . . . ',1pg20.13/,
295 . ' NORMAL DRAW-BEAD FORCE / UNIT LENGTH . . . ',/,
296 . ' AT THE FIRST NODE. . . . . . . ',1pg20.13/,
297 . ' NORMAL DRAW-BEAD FORCE / UNIT LENGTH . . . ',/,
298 . ' AT THE LAST NODE . . . . . . . ',1pg20.13/,
299 . ' DRAW-BEAD DEPTH . . . . . . . . . . . . . ',1pg20.13/,
300 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
301 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
302 . ' MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
303 . ' FORMULATION FOR TANGENTIAL FORCE COMPUTATION',/,
304 . ' (1: VISCOUS, 2: INCREMENTAL) . . .',i1/,
305 . ' DEACTIVATION FLAG FOR RETRAINING FORCE REDUCING',i1/)
306
my_real
#define my_real
Definition cppsort.cpp:32
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
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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