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 I,J,L, 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 CHARACTER(LEN=NCHARTITLE)::MSGTITL
83 CHARACTER(LEN=NCHARKEY)::OPT,KEY,KEY1
84 CHARACTER(LEN=NCHARFIELD)::BCFLAG,BCFLAGM
85!
86 INTEGER, DIMENSION(:), POINTER :: INGR2USR
87 LOGICAL IS_AVAILABLE
88C-----------------------------------------------
89C E x t e r n a l F u n c t i o n s
90C-----------------------------------------------
91 INTEGER USR2SYS,SUR2USR,NGR2USR
92C-----------------------------------------------
93C=======================================================================
94C READING ALE INTERFACE /INTER/TYPE12
95C=======================================================================
96
97C Initializations
98 is1=0
99 is2=0
100 igsti=0
101 ilev= 0
102 hiera=0
103 bcopt=0
104C
105 fric = zero
106 gap = zero
107 startt = zero
108 stopt=ep30
109
110C
111 ntyp = 12
112 ipari(15)=noint
113 ipari(7)=ntyp
114
115 is_available=.false.
116
117C------------------------------------------------------------
118C Card1 :flags
119C------------------------------------------------------------
120
121 CALL hm_get_intv('secondaryentityids', isu1, is_available, lsubmodel)
122 CALL hm_get_intv('mainentityids', isu2, is_available, lsubmodel)
123 CALL hm_get_intv('type12_interpol', ilev, is_available, lsubmodel)
124 igsti=0
125 hiera=0
126
127C....* CHECKS *.............
128
129 is1=1
130 is2=1
131 ingr2usr => igrsurf(1:nsurf)%ID
132 isu1=ngr2usr(isu1,ingr2usr,nsurf)
133 isu2=ngr2usr(isu2,ingr2usr,nsurf)
134
135C.......* Storage IPARI FRIGAP *........
136 ipari(45)=isu1
137 ipari(46)=isu2
138 ipari(13)=is1*10+is2
139
140C------------------------------------------------------------
141C Card2
142C------------------------------------------------------------
143 CALL hm_get_floatv('type12_tol', gap, is_available, lsubmodel, unitab)
144 bid=zero
145 startt=zero
146 stopt=zero
147C
148C.....* CHECKS *.....
149C
150 IF(gap==0.)gap=two*em02
151C------------------------------------------------------------
152C Card3
153C------------------------------------------------------------
154 CALL hm_get_intv('type12_itied', itied, is_available, lsubmodel)
155 CALL hm_get_intv('type12_bcopt', bcopt, is_available, lsubmodel)
156 CALL hm_get_intv('SKEW_CSID', iskew, is_available, lsubmodel)
157 CALL hm_get_intv('Node_C', icenter, is_available, lsubmodel)
158
159C.....* CHECKS *.....
160
161 IF(hiera==0)hiera=itied+1
162 IF(bcopt==0)bcopt=2
163 ipari(26)=hiera
164 nhin2=max(nhin2,hiera)
165
166 ipari(11)=bcopt
167C
168C------------------------------------------------------------
169C Optional Card4 Card5 Card6 : Transformation parameters
170C------------------------------------------------------------
171 IF(itied==2)THEN
172 CALL hm_get_floatv('type12_Xc', xc, is_available, lsubmodel, unitab)
173 CALL hm_get_floatv('type12_Yc', yc, is_available, lsubmodel, unitab)
174 CALL hm_get_floatv('type12_Zc', zc, is_available, lsubmodel, unitab)
175
176 CALL hm_get_floatv('type12_XN', xr, is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('type12_YN', yr, is_available, lsubmodel, unitab)
178 CALL hm_get_floatv('type12_ZN', zr, is_available, lsubmodel, unitab)
179 CALL hm_get_floatv('type12_theta', teta, is_available, lsubmodel, unitab)
180
181 CALL hm_get_floatv('type12_XT', xt, is_available, lsubmodel, unitab)
182 CALL hm_get_floatv('type12_YT', yt, is_available, lsubmodel, unitab)
183 CALL hm_get_floatv('type12_ZT', zt, is_available, lsubmodel, unitab)
184
185 ENDIF
186
187C.....* Storage IPARI FRIGAP *.......
188 frigap(3)=startt
189 IF (stopt == zero) stopt = ep30
190 frigap(11)=stopt
191
192C------------------------------------------------------------
193C General Storage IPARI FRIGAP
194C------------------------------------------------------------
195
196 IF (stfac == zero) stfac = one_fifth
197 frigap(1)=itied+0.1
198 frigap(2)=gap
199
200C FRIGAP 5->14 EST MIS A JOUR DANS IN12R
201 IF(itied==2) THEN
202 frigap(4)=teta
203 frigap(5)=xt
204 frigap(6)=yt
205 frigap(7)=zt
206 frigap(8)=xc
207 frigap(9)=yc
208 frigap(10)=zc
209 frigap(12)=xr
210 frigap(13)=yr
211 frigap(14)=zr
212 ELSE
213 ipari(20)=ilev
214 ipari(21)=0
215 IF(icenter>0)THEN
216 ipari(22)=usr2sys(icenter,itabm1,mess,ipari(15))
217 ELSE
218 ipari(22)=0
219 ENDIF
220 IF(ilev==1)THEN
221 IF(iskew>0)THEN
222 DO 640 j=0,numskw
223 IF(iskew==iskn(4,j+1)) THEN
224 iskew=j
225 GO TO 660
226 ENDIF
227 640 CONTINUE
228 WRITE(istdo,641)
229 WRITE(iout,641)
230 641 FORMAT(' ** ERROR INTERF TYPE 12 WRONG SKEW SYSTEM NUMBER')
231 ierr=ierr+1
232 660 CONTINUE
233 IF(iskn(1,j+1)==0)THEN
234 WRITE(istdo,'(a)')'** WARNING INTERFACE 12'
235 iwarn=iwarn+1
236 WRITE(iout,642) icenter
237 642 FORMAT(' ** INTERF TYPE 12 SKEW SYSTEM IS FIXED,',
238 & ' USING CENTER NODE', i8,
239 & ' AND SKEW AXIS 1 FOR POLAR COORDINATE SYSTEM')
240 ELSE
241 icenter=itab(iskn(1,j+1))
242 ipari(22)=iskn(1,j+1)
243 ENDIF
244 ELSE
245 WRITE(istdo,'(a)')'** WARNING INTERFACE 12'
246 iwarn=iwarn+1
247 WRITE(iout,643)
248 643 FORMAT(' ** INTERF TYPE 12, USING ORIGIN AND X-AXIS',
249 & ' FOR POLAR COORDINATE SYSTEM')
250 ENDIF
251 ipari(21)=iskew
252 ENDIF
253 ENDIF
254
255C
256C------------------------------------------------------------
257C PRINTOUT
258C------------------------------------------------------------
259C
260 WRITE(iout,1512)gap,itied,ipari(11)
261 IF(ipari(20)==1)WRITE(iout,2512)ipari(21),icenter
262 IF(ipari(20)==2)WRITE(iout,2513)ipari(21)
263 IF(itied==2) WRITE(iout,1513)xt,yt,zt,xc,yc,zc,xr,yr,zr,teta
264
265C--------------------------------------------------------------
266 IF(is1==0)THEN
267 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
268 ELSEIF(is1==1)THEN
269 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
270 ELSEIF(is1==2)THEN
271 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
272 ELSEIF(is1==3)THEN
273 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
274 ELSEIF(is1==4 )THEN
275 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
276 ELSEIF(is1==5 )THEN
277 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
278 ENDIF
279 IF(is2==0)THEN
280 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
281 ELSEIF(is2==1)THEN
282 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
283 ELSEIF(is2==2)THEN
284 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
285 ELSEIF(is2==3)THEN
286 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
287 ELSEIF(is2==4)THEN
288 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
289 . 'TO HYPER-ELLIPSOIDAL SURFACE'
290 ENDIF
291C
292C--------------------------------------------------------------
293 1000 FORMAT(/1x,' INTERFACE NUMBER :',i10,1x,a)
294C------------
295 RETURN
296
297
298 1512 FORMAT(//
299 . ' TYPE==12 FLUID/FLUID INTERFACE ' //,
300 . ' TOLERANCE TO FIND MAIN SEGMENT . . . . . ',1pg20.13/,
301 . ' ITIED . . . . . . . . . . . . . . . . . . . ',i1/,
302 . ' 0: SLIDING (NOVOID)'/,
303 . ' 1: TIED '/,
304 . ' 2: PERIODIC BOUNDARY CONDITION '/,
305 . ' 3: SLIDING NO FLUX '/,
306 . ' BCCOD (DEFAULT 2) . . . . . . . . . . . . . ',i1/,
307 . ' 1: NORMAL CHECK '/,
308 . ' 2: SECONDARY DEACTIVATION (RBY & INTER TYPE2) '/,
309 . ' 3: SECONDARY DEACTIVATION (B.C., RBY & INTER TYPE2)'/)
310
311 1513 FORMAT(
312 . ' TRANSLATION VECTOR XT . . . . . . . . . . ',1pg20.13/,
313 . ' YT . . . . . . . . . . ',1pg20.13/,
314 . ' ZT . . . . . . . . . . ',1pg20.13/,
315 . ' ROTATION CENTER XC . . . . . . . . . . ',1pg20.13/,
316 . ' YC . . . . . . . . . . ',1pg20.13/,
317 . ' ZC . . . . . . . . . . ',1pg20.13/,
318 . ' ROTATION VECTOR XR . . . . . . . . . . ',1pg20.13/,
319 . ' YR . . . . . . . . . . ',1pg20.13/,
320 . ' ZR . . . . . . . . . . ',1pg20.13/,
321 . ' ROTATION ANGLE TETA . . . . . . . . . . ',1pg20.13/)
322
323 2512 FORMAT( ' POLAR INTERPOLATION : SKEW SYSTEM NUMBER . ',i10/,
324 . ' CENTER NODE . . . . . . . . . . . . . . . . ',i10/)
325 2513 FORMAT( ' SPHERICAL INTERPOLATION : CENTER NODE . . . ',i10/)
326
327
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
max
#define max(a, b)
Definition macros.h:21
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
unitab_mod
Definition unitab_mod.F:513
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
submodel_mod::submodel_data
Definition submodel_mod.F:723