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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type03 (ipari, stfac, frigap, noint, igrsurf, unitab, lsubmodel, npari, nparir)

Function/Subroutine Documentation

◆ hm_read_inter_type03()

subroutine hm_read_inter_type03 ( integer, dimension(npari) ipari,
stfac,
frigap,
integer noint,
type (surf_), dimension(nsurf), target igrsurf,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*) lsubmodel,
integer, intent(in) npari,
integer, intent(in) nparir )
Parameters
[in]nparirarray sizes (IPARI and FRIGAP)

Definition at line 35 of file hm_read_inter_type03.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,INTENT(IN) :: NPARI, NPARIR !< array sizes (IPARI and FRIGAP)
60 INTEGER ISU1,ISU2,ILAGM,NOINT
61 INTEGER IPARI(NPARI)
62 my_real stfac
63 my_real frigap(nparir)
64C-----------------------------------------------
65 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
66 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
67 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "units_c.inc"
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I,J,L, NTYP,IS1, IS2,IDELKEEP,ILEV,
78 . INACTI, IBC1, IBC2, IBC3,IBC1M, IBC2M, IBC3M,
79 . IGSTI,IDEL3,IVOID,IRS,IRM,INTKG
80 my_real
81 . fric,gap,startt,stopt,visc,viscf,gapscale,ptmax
82 CHARACTER(LEN=40)::MESS
83 CHARACTER(LEN=NCHARTITLE)::MSGTITL
84 CHARACTER(LEN=NCHARKEY)::OPT,KEY,KEY1
85 CHARACTER(LEN=NCHARFIELD)::BCFLAG,BCFLAGM
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 PENALTY INTERFACE /INTER/TYPE3
96C=======================================================================
97
98C Initializations
99 is1=0
100 is2=0
101 idelkeep=0
102 idel3= 0
103 inacti = 0
104 igsti = 0
105 ilev = 0
106 ibc1=0
107 ibc2=0
108 ibc3=0
109 ibc1m=0
110 ibc2m=0
111 ibc3m=0
112 intkg = 0
113C
114 fric = zero
115 gap = zero
116 gapscale = zero
117 startt = zero
118 stopt=ep30
119 visc = zero
120 viscf = zero
121 ptmax=ep30
122C
123 ntyp = 3
124 ipari(15)=noint
125 ipari(7)=ntyp
126C
127 is_available = .false.
128C--------------------------------------------------
129C EXTRACT DATAS (INTEGER VALUES)
130C--------------------------------------------------
131C
132 CALL hm_get_intv('mainentityids',isu1,is_available,lsubmodel)
133 CALL hm_get_intv('secondaryentityids',isu2,is_available,lsubmodel)
134 CALL hm_get_intv('NodDel3',idel3,is_available,lsubmodel)
135C
136 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
137 CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
138 CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
139 CALL hm_get_intv('Gflag',irs,is_available,lsubmodel)
140 CALL hm_get_intv('Vflag',irm,is_available,lsubmodel)
141C
142C--------------------------------------------------
143C EXTRACT DATAS (REAL VALUES)
144C--------------------------------------------------
145
146 CALL hm_get_floatv('TYPE3_SCALE',stfac,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
148 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
149 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
150 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
151C
152 CALL hm_get_floatv('Ptlim',ptmax,is_available,lsubmodel,unitab)
153C
154C--------------------------------------------------
155C CHECKS And Storage IPARI FRIGAP
156C--------------------------------------------------
157C
158
159C
160C....* Card1 :flags *.............
161C
162
163 is1=1
164 is2=1
165 ingr2usr => igrsurf(1:nsurf)%ID
166 isu1=ngr2usr(isu1,ingr2usr,nsurf)
167 isu2=ngr2usr(isu2,ingr2usr,nsurf)
168 IF (idel3 < 0) THEN
169 idelkeep=1
170 idel3=abs(idel3)
171 END IF
172 ipari(61)=idelkeep
173 IF (idel3>2.OR.n2d==1) idel3 = 0
174 ipari(17)=idel3
175
176C.......* Storage IPARI FRIGAP *........
177 ipari(45)=isu1
178 ipari(46)=isu2
179 ipari(13)=is1*10+is2
180 ipari(20)=ilev
181
182C
183C....* Card2 *.............
184C
185 IF(stfac==zero) stfac=one_fifth
186
187 IF (stopt == zero) stopt = ep30
188
189C.....* Storage IPARI FRIGAP *.......
190 frigap(1)=fric
191 frigap(2)=gap
192 frigap(3)=startt
193 frigap(11)=stopt
194
195C
196C....* Card3 *.............
197C
198 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
199
200
201 ipari(24) = irm
202 ipari(25) = irs
203
204 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
205 frigap(14)=visc
206
207C
208C....* Card4 *.............
209C
210 IF(ptmax==zero) ptmax=ep30
211
212 frigap(16)=ptmax
213C
214 ipari(65) = intkg
215
216C
217C------------------------------------------------------------
218C PRINTOUT
219C------------------------------------------------------------
220C
221 WRITE(iout,1503)ibc1,ibc2,ibc3,stfac,fric,gap,startt,stopt,
222 . irs,irm,ptmax
223 IF(idel3/=0) THEN
224 WRITE(iout,'(A,A,I5/)')
225 . ' DELETION FLAG ON FAILURE OF ELEMENT',
226 . ' (1:YES-ALL/2:YES-ANY) SET TO ',idel3
227 IF(idelkeep == 1)THEN
228 WRITE(iout,'(A/)')
229 . ' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
230 ENDIF
231 ENDIF
232
233C--------------------------------------------------------------
234 IF(is1==0)THEN
235 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
236 ELSEIF(is1==1)THEN
237 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
238 ELSEIF(is1==2)THEN
239 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
240 ELSEIF(is1==3)THEN
241 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
242 ELSEIF(is1==4 )THEN
243 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
244 ELSEIF(is1==5 )THEN
245 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
246 ENDIF
247 IF(is2==0)THEN
248 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
249 ELSEIF(is2==1)THEN
250 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
251 ELSEIF(is2==2)THEN
252 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
253 ELSEIF(is2==3)THEN
254 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
255 ELSEIF(is2==4)THEN
256 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
257 . 'TO HYPER-ELLIPSOIDAL SURFACE'
258 ENDIF
259C
260C--------------------------------------------------------------
261 1000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
262C------------
263 RETURN
264
265 1503 FORMAT(//
266 . ' TYPE==3 SLIDING AND VOIDS ' //,
267 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
268 . ' (1:YES 0:NO) Y DIR ',i1/,
269 . ' Z DIR ',i1/,
270 . ' STIFFNESS FACTOR. . . . . . . . . . . . . ',1pg20.13/,
271 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
272 . ' INITIAL GAP . . . . . . . . . . . . . . . ',1pg20.13/,
273 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
274 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
275 . ' SECONDARY SURFACE REORDERING FLAG . . . . . . ',i1/,
276 . ' MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
277 . ' tangential pressure limit. . .. . . . . . ',1PG20.13/)
278
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
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