OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type12.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_type12 ../starter/source/interfaces/int12/hm_read_inter_type12.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_fsi ../starter/source/interfaces/reader/hm_read_inter_fsi.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| ngr2usr ../starter/source/system/nintrr.F
31!|| usr2sys ../starter/source/system/sysfus.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_type12(
37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRSURF ,ITAB ,ITABM1 ,ISKN ,
39 3 LSUBMODEL ,UNITAB ,SITAB ,SITABM1 ,
40 4 NPARI ,NPARIR ,SISKWN ,LISKN)
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
324 END
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
hm_read_inter_type12
subroutine hm_read_inter_type12(ipari, stfac, frigap, noint, igrsurf, itab, itabm1, iskn, lsubmodel, unitab, sitab, sitabm1, npari, nparir, siskwn, liskn)
Definition hm_read_inter_type12.F:41
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
submodel_mod::submodel_data
Definition submodel_mod.F:728