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