OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type03.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_type03 ../starter/source/interfaces/int03/hm_read_inter_type03.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_struct ../starter/source/interfaces/reader/hm_read_inter_struct.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!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
35 SUBROUTINE hm_read_inter_type03(
36 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
37 2 IGRSURF ,UNITAB ,LSUBMODEL ,NPARI ,
38 3 NPARIR )
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,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 NTYP,IS1, IS2,IDELKEEP,ILEV,
78 . INACTI, IBC1, IBC2, IBC3,IBC1M, IBC2M, IBC3M,
79 . IGSTI,IDEL3,IRS,IRM,INTKG
80 my_real
81 . fric,gap,startt,stopt,visc,viscf,gapscale,ptmax
82
83!
84 INTEGER, DIMENSION(:), POINTER :: INGR2USR
85C-----------------------------------------------
86C E x t e r n a l F u n c t i o n s
87C-----------------------------------------------
88 INTEGER NGR2USR
89 LOGICAL IS_AVAILABLE
90C-----------------------------------------------
91C=======================================================================
92C READING PENALTY INTERFACE /INTER/TYPE3
93C=======================================================================
94
95C Initializations
96 is1=0
97 is2=0
98 idelkeep=0
99 idel3= 0
100 inacti = 0
101 igsti = 0
102 ilev = 0
103 ibc1=0
104 ibc2=0
105 ibc3=0
106 ibc1m=0
107 ibc2m=0
108 ibc3m=0
109 intkg = 0
110C
111 fric = zero
112 gap = zero
113 gapscale = zero
114 startt = zero
115 stopt=ep30
116 visc = zero
117 viscf = zero
118 ptmax=ep30
119C
120 ntyp = 3
121 ipari(15)=noint
122 ipari(7)=ntyp
123C
124 is_available = .false.
125C--------------------------------------------------
126C EXTRACT DATAS (INTEGER VALUES)
127C--------------------------------------------------
128C
129 CALL hm_get_intv('mainentityids',isu1,is_available,lsubmodel)
130 CALL hm_get_intv('secondaryentityids',isu2,is_available,lsubmodel)
131 CALL hm_get_intv('NodDel3',idel3,is_available,lsubmodel)
132C
133 CALL hm_get_intv('Deactivate_X_BC',ibc1,is_available,lsubmodel)
134 CALL hm_get_intv('Deactivate_Y_BC',ibc2,is_available,lsubmodel)
135 CALL hm_get_intv('Deactivate_Z_BC',ibc3,is_available,lsubmodel)
136 CALL hm_get_intv('Gflag',irs,is_available,lsubmodel)
137 CALL hm_get_intv('Vflag',irm,is_available,lsubmodel)
138C
139C--------------------------------------------------
140C EXTRACT DATAS (REAL VALUES)
141C--------------------------------------------------
142
143 CALL hm_get_floatv('TYPE3_SCALE',stfac,is_available,lsubmodel,unitab)
144 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
145 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv('TSTART',startt,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv('TSTOP',stopt,is_available,lsubmodel,unitab)
148C
149 CALL hm_get_floatv('Ptlim',ptmax,is_available,lsubmodel,unitab)
150C
151C--------------------------------------------------
152C CHECKS And Storage IPARI FRIGAP
153C--------------------------------------------------
154C
155
156C
157C....* Card1 :flags *.............
158C
159
160 is1=1
161 is2=1
162 ingr2usr => igrsurf(1:nsurf)%ID
163 isu1=ngr2usr(isu1,ingr2usr,nsurf)
164 isu2=ngr2usr(isu2,ingr2usr,nsurf)
165 IF (idel3 < 0) THEN
166 idelkeep=1
167 idel3=abs(idel3)
168 END IF
169 ipari(61)=idelkeep
170 IF (idel3>2.OR.n2d==1) idel3 = 0
171 ipari(17)=idel3
172
173C.......* Storage IPARI FRIGAP *........
174 ipari(45)=isu1
175 ipari(46)=isu2
176 ipari(13)=is1*10+is2
177 ipari(20)=ilev
178
179C
180C....* Card2 *.............
181C
182 IF(stfac==zero) stfac=one_fifth
183
184 IF (stopt == zero) stopt = ep30
185
186C.....* Storage IPARI FRIGAP *.......
187 frigap(1)=fric
188 frigap(2)=gap
189 frigap(3)=startt
190 frigap(11)=stopt
191
192C
193C....* Card3 *.............
194C
195 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
196
197
198 ipari(24) = irm
199 ipari(25) = irs
200
201 ipari(11)=4*ibc1+2*ibc2+ibc3 + 8 *(4*ibc1m+2*ibc2m+ibc3m)
202 frigap(14)=visc
203
204C
205C....* Card4 *.............
206C
207 IF(ptmax==zero) ptmax=ep30
208
209 frigap(16)=ptmax
210C
211 ipari(65) = intkg
212
213C
214C------------------------------------------------------------
215C PRINTOUT
216C------------------------------------------------------------
217C
218 WRITE(iout,1503)ibc1,ibc2,ibc3,stfac,fric,gap,startt,stopt,
219 . irs,irm,ptmax
220 IF(idel3/=0) THEN
221 WRITE(iout,'(A,A,I5/)')
222 . ' DELETION FLAG ON FAILURE OF ELEMENT',
223 . ' (1:YES-ALL/2:YES-ANY) SET TO ',idel3
224 IF(idelkeep == 1)THEN
225 WRITE(iout,'(A/)')
226 . ' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
227 ENDIF
228 ENDIF
229
230C--------------------------------------------------------------
231 IF(is1==0)THEN
232 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
233 ELSEIF(is1==1)THEN
234 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
235 ELSEIF(is1==2)THEN
236 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
237 ELSEIF(is1==3)THEN
238 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
239 ELSEIF(is1==4 )THEN
240 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
241 ELSEIF(is1==5 )THEN
242 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
243 ENDIF
244 IF(is2==0)THEN
245 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
246 ELSEIF(is2==1)THEN
247 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
248 ELSEIF(is2==2)THEN
249 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
250 ELSEIF(is2==3)THEN
251 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
252 ELSEIF(is2==4)THEN
253 WRITE(iout,'(6X,A)')'MAIN SURFACE REFERS ',
254 . 'TO HYPER-ELLIPSOIDAL SURFACE'
255 ENDIF
256C
257C--------------------------------------------------------------
258C------------
259 RETURN
260
261 1503 FORMAT(//
262 . ' TYPE==3 SLIDING AND VOIDS ' //,
263 . ' BOUND. COND. DELETED AFTER IMPACT IN X DIR ',i1/,
264 . ' (1:YES 0:NO) Y DIR ',i1/,
265 . ' Z DIR ',i1/,
266 . ' STIFFNESS FACTOR. . . . . . . . . . . . . ',1pg20.13/,
267 . ' FRICTION FACTOR . . . . . . . . . . . . . ',1pg20.13/,
268 . ' INITIAL GAP . . . . . . . . . . . . . . . ',1pg20.13/,
269 . ' START TIME. . . . . . . . . . . . . . . . ',1pg20.13/,
270 . ' STOP TIME . . . . . . . . . . . . . . . . ',1pg20.13/,
271 . ' SECONDARY SURFACE REORDERING FLAG . . . . . . ',i1/,
272 . ' MAIN SURFACE REORDERING FLAG. . . . . . ',i1/,
273 . ' TANGENTIAL PRESSURE LIMIT. . .. . . . . . ',1pg20.13/)
274
275 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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_read_inter_type03
subroutine hm_read_inter_type03(ipari, stfac, frigap, noint, igrsurf, unitab, lsubmodel, npari, nparir)
Definition hm_read_inter_type03.F:39
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
unitab_mod
Definition unitab_mod.F:517
submodel_mod::submodel_data
Definition submodel_mod.F:728