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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type12 (ipari, stfac, frigap, noint, igrsurf, itab, itabm1, iskn, lsubmodel, unitab, sitab, sitabm1, npari, nparir, siskwn, liskn)

Function/Subroutine Documentation

◆ hm_read_inter_type12()

subroutine hm_read_inter_type12 ( integer, dimension(npari) ipari,
stfac,
frigap,
integer noint,
type (surf_), dimension(nsurf), target igrsurf,
integer, dimension(sitab) itab,
integer, dimension(sitabm1) itabm1,
integer, dimension(liskn,siskwn/liskn) iskn,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
type (unit_type_), intent(in) unitab,
integer, intent(in) sitab,
integer, intent(in) sitabm1,
integer, intent(in) npari,
integer, intent(in) nparir,
integer, intent(in) siskwn,
integer, intent(in) liskn )
Parameters
[in]lisknarray sizes

Definition at line 36 of file hm_read_inter_type12.F.

41C============================================================================
42C
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47 USE groupdef_mod
48 USE submodel_mod , ONLY : submodel_data, nsubmod
49 USE unitab_mod
50 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com04_c.inc"
59#include "com09_c.inc"
60#include "units_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER,INTENT(IN) :: SITAB,SITABM1,NPARI,NPARIR,SISKWN,LISKN !< array sizes
65 INTEGER ISU1,ISU2,NOINT
66 INTEGER IPARI(NPARI),ISKN(LISKN,SISKWN/LISKN),ITAB(SITAB),ITABM1(SITABM1)
67 my_real stfac
68 my_real frigap(nparir)
69 TYPE(SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(NSUBMOD)
70 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
71C-----------------------------------------------
72 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER J, NTYP,IS1, IS2,IGSTI,ILEV,ITIED,HIERA,
77 . BCOPT,ISKEW,ICENTER
78 my_real
79 . fric,gap,startt,stopt,bid,xc,yc,zc,xr,yr,zr,teta,
80 . xt,yt,zt
81 CHARACTER(LEN=40)::MESS
82!
83 INTEGER, DIMENSION(:), POINTER :: INGR2USR
84 LOGICAL IS_AVAILABLE
85C-----------------------------------------------
86C E x t e r n a l F u n c t i o n s
87C-----------------------------------------------
88 INTEGER USR2SYS,NGR2USR
89C-----------------------------------------------
90C=======================================================================
91C READING ALE INTERFACE /INTER/TYPE12
92C=======================================================================
93
94C Initializations
95 is1=0
96 is2=0
97 igsti=0
98 ilev= 0
99 hiera=0
100 bcopt=0
101C
102 fric = zero
103 gap = zero
104 startt = zero
105 stopt=ep30
106
107C
108 ntyp = 12
109 ipari(15)=noint
110 ipari(7)=ntyp
111
112 is_available=.false.
113
114C------------------------------------------------------------
115C Card1 :flags
116C------------------------------------------------------------
117
118 CALL hm_get_intv('secondaryentityids', isu1, is_available, lsubmodel)
119 CALL hm_get_intv('mainentityids', isu2, is_available, lsubmodel)
120 CALL hm_get_intv('type12_interpol', ilev, is_available, lsubmodel)
121 igsti=0
122 hiera=0
123
124C....* CHECKS *.............
125
126 is1=1
127 is2=1
128 ingr2usr => igrsurf(1:nsurf)%ID
129 isu1=ngr2usr(isu1,ingr2usr,nsurf)
130 isu2=ngr2usr(isu2,ingr2usr,nsurf)
131
132C.......* Storage IPARI FRIGAP *........
133 ipari(45)=isu1
134 ipari(46)=isu2
135 ipari(13)=is1*10+is2
136
137C------------------------------------------------------------
138C Card2
139C------------------------------------------------------------
140 CALL hm_get_floatv('type12_tol', gap, is_available, lsubmodel, unitab)
141 bid=zero
142 startt=zero
143 stopt=zero
144C
145C.....* CHECKS *.....
146C
147 IF(gap==0.)gap=two*em02
148C------------------------------------------------------------
149C Card3
150C------------------------------------------------------------
151 CALL hm_get_intv('type12_itied', itied, is_available, lsubmodel)
152 CALL hm_get_intv('type12_bcopt', bcopt, is_available, lsubmodel)
153 CALL hm_get_intv('SKEW_CSID', iskew, is_available, lsubmodel)
154 CALL hm_get_intv('Node_C', icenter, is_available, lsubmodel)
155
156C.....* CHECKS *.....
157
158 IF(hiera==0)hiera=itied+1
159 IF(bcopt==0)bcopt=2
160 ipari(26)=hiera
161 nhin2=max(nhin2,hiera)
162
163 ipari(11)=bcopt
164C
165C------------------------------------------------------------
166C Optional Card4 Card5 Card6 : Transformation parameters
167C------------------------------------------------------------
168 IF(itied==2)THEN
169 CALL hm_get_floatv('type12_Xc', xc, is_available, lsubmodel, unitab)
170 CALL hm_get_floatv('type12_Yc', yc, is_available, lsubmodel, unitab)
171 CALL hm_get_floatv('type12_Zc', zc, is_available, lsubmodel, unitab)
172
173 CALL hm_get_floatv('type12_XN', xr, is_available, lsubmodel, unitab)
174 CALL hm_get_floatv('type12_YN', yr, is_available, lsubmodel, unitab)
175 CALL hm_get_floatv('type12_ZN', zr, is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('type12_theta', teta, is_available, lsubmodel, unitab)
177
178 CALL hm_get_floatv('type12_XT', xt, is_available, lsubmodel, unitab)
179 CALL hm_get_floatv('type12_YT', yt, is_available, lsubmodel, unitab)
180 CALL hm_get_floatv('type12_ZT', zt, is_available, lsubmodel, unitab)
181
182 ENDIF
183
184C.....* Storage IPARI FRIGAP *.......
185 frigap(3)=startt
186 IF (stopt == zero) stopt = ep30
187 frigap(11)=stopt
188
189C------------------------------------------------------------
190C General Storage IPARI FRIGAP
191C------------------------------------------------------------
192
193 IF (stfac == zero) stfac = one_fifth
194 frigap(1)=itied+0.1
195 frigap(2)=gap
196
197C FRIGAP 5->14 IS UPDATED IN IN12R
198 IF(itied==2) THEN
199 frigap(4)=teta
200 frigap(5)=xt
201 frigap(6)=yt
202 frigap(7)=zt
203 frigap(8)=xc
204 frigap(9)=yc
205 frigap(10)=zc
206 frigap(12)=xr
207 frigap(13)=yr
208 frigap(14)=zr
209 ELSE
210 ipari(20)=ilev
211 ipari(21)=0
212 IF(icenter>0)THEN
213 ipari(22)=usr2sys(icenter,itabm1,mess,ipari(15))
214 ELSE
215 ipari(22)=0
216 ENDIF
217 IF(ilev==1)THEN
218 IF(iskew>0)THEN
219 DO 640 j=0,numskw
220 IF(iskew==iskn(4,j+1)) THEN
221 iskew=j
222 GO TO 660
223 ENDIF
224 640 CONTINUE
225 WRITE(istdo,641)
226 WRITE(iout,641)
227 641 FORMAT(' ** ERROR INTERF TYPE 12 WRONG SKEW SYSTEM NUMBER')
228 ierr=ierr+1
229 660 CONTINUE
230 IF(iskn(1,j+1)==0)THEN
231 WRITE(istdo,'(a)')'** WARNING INTERFACE 12'
232 iwarn=iwarn+1
233 WRITE(iout,642) icenter
234 642 FORMAT(' ** INTERF TYPE 12 SKEW SYSTEM IS FIXED,',
235 & ' USING CENTER NODE', i8,
236 & ' AND SKEW AXIS 1 FOR POLAR COORDINATE SYSTEM')
237 ELSE
238 icenter=itab(iskn(1,j+1))
239 ipari(22)=iskn(1,j+1)
240 ENDIF
241 ELSE
242 WRITE(istdo,'(a)')'** WARNING INTERFACE 12'
243 iwarn=iwarn+1
244 WRITE(iout,643)
245 643 FORMAT(' ** INTERF TYPE 12, USING ORIGIN AND X-AXIS',
246 & ' FOR POLAR COORDINATE SYSTEM')
247 ENDIF
248 ipari(21)=iskew
249 ENDIF
250 ENDIF
251
252C
253C------------------------------------------------------------
254C PRINTOUT
255C------------------------------------------------------------
256C
257 WRITE(iout,1512)gap,itied,ipari(11)
258 IF(ipari(20)==1)WRITE(iout,2512)ipari(21),icenter
259 IF(ipari(20)==2)WRITE(iout,2513)ipari(21)
260 IF(itied==2) WRITE(iout,1513)xt,yt,zt,xc,yc,zc,xr,yr,zr,teta
261
262C--------------------------------------------------------------
263 IF(is1==0)THEN
264 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
265 ELSEIF(is1==1)THEN
266 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
267 ELSEIF(is1==2)THEN
268 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
269 ELSEIF(is1==3)THEN
270 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
271 ELSEIF(is1==4 )THEN
272 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
273 ELSEIF(is1==5 )THEN
274 WRITE(iout,'(6x,a)')'secondary side input by solid elements'
275 ENDIF
276 IF(IS2==0)THEN
277 WRITE(IOUT,'(6x,a)')'no main surface input'
278 ELSEIF(IS2==1)THEN
279 WRITE(IOUT,'(6x,a)')'main surface input by segments'
280 ELSEIF(IS2==2)THEN
281 WRITE(IOUT,'(6x,a)')'main surface input by nodes'
282 ELSEIF(IS2==3)THEN
283 WRITE(IOUT,'(6x,a)')'main surface input by segments'
284 ELSEIF(IS2==4)THEN
285 WRITE(IOUT,'(6x,a)')'main surface refers ',
286 . 'to hyper-ellipsoidal surface'
287 ENDIF
288C
289C--------------------------------------------------------------
290C------------
291 RETURN
292
293
294 1512 FORMAT(//
295 . ' type==12 fluid/fluid INTERFACE ' //,
296 . ' tolerance to find main segment . . . . . ',1PG20.13/,
297 . ' itied . . . . . . . . . . . . . . . . . . . ',I1/,
298 . ' 0: sliding(novoid)'/,
299 . ' 1: tied '/,
300 . ' 2: periodic boundary condition '/,
301 . ' 3: sliding no flux '/,
302 . ' bccod(default 2) . . . . . . . . . . . . . ',I1/,
303 . ' 1: normal check '/,
304 . ' 2: secondary deactivation(rby & inter type2) '/,
305 . ' 3: secondary deactivation(b.c., rby & inter type2)'/)
306
307 1513 FORMAT(
308 . ' translation vector xt . . . . . . . . . . ',1PG20.13/,
309 . ' yt . . . . . . . . . . ',1PG20.13/,
310 . ' zt . . . . . . . . . . ',1PG20.13/,
311 . ' rotation center xc . . . . . . . . . . ',1PG20.13/,
312 . ' yc . . . . . . . . . . ',1PG20.13/,
313 . ' zc . . . . . . . . . . ',1PG20.13/,
314 . ' rotation vector xr . . . . . . . . . . ',1PG20.13/,
315 . ' yr . . . . . . . . . . ',1PG20.13/,
316 . ' zr . . . . . . . . . . ',1PG20.13/,
317 . ' rotation angle teta . . . . . . . . . . ',1PG20.13/)
318
319 2512 FORMAT( ' polar interpolation : skew system number . ',I10/,
320 . ' center node . . . . . . . . . . . . . . . . ',I10/)
321 2513 FORMAT( ' spherical interpolation : center node . . . ',I10/)
322
323
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
max
#define max(a, b)
Definition macros.h:21
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
submodel_mod::submodel_data
Definition submodel_mod.F:728