OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type10.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_type10 ../starter/source/interfaces/int10/hm_read_inter_type10.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_struct ../starter/source/interfaces/reader/hm_read_inter_struct.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| ngr2usr ../starter/source/system/nintrr.F
32!||--- uses -----------------------------------------------------
33!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
34!|| message_mod ../starter/share/message_module/message_mod.F
35!|| submodel_mod ../starter/share/modules1/submodel_mod.F
36!||====================================================================
38 . IPARI ,STFAC ,FRIGAP ,IGRNOD ,IGRSURF ,
39 . LSUBMODEL,UNITAB ,TITR ,NOINT )
40C=======================================================================
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE groupdef_mod
46 USE elbuftag_mod
47 USE submodel_mod
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-----------------------------------------------
56#include "scr06_c.inc"
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "units_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER :: NOINT
64 my_real :: STFAC
65 INTEGER, DIMENSION(*) :: IPARI
66 my_real, DIMENSION(*) :: frigap
67 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
68 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
69 TYPE (SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
70C-----------------------------------------------
71 TYPE (GROUP_) ,TARGET ,DIMENSION(NGRNOD) :: IGRNOD
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 :: NTYP,IS1,IS2,ISU1,ISU2,IDELKEEP,ILEV,IGAP,INACTI,IDEL10,MULTIMP,ITIED
77 my_real :: FRIC,GAP,STARTT,STOPT,VISC,BUMULT,GAPMAX,FPENMAX
78 INTEGER, DIMENSION(:), POINTER :: INGR2USR
79 LOGICAL :: IS_AVAILABLE
80C-----------------------------------------------
81C E x t e r n a l F u n c t i o n s
82C-----------------------------------------------
83 INTEGER NGR2USR
84C=======================================================================
85c Initializations
86c--------------------------------------------------------
87 ntyp = 10
88 igap = 0
89 ilev = 0
90 multimp = 4
91 idelkeep = 0
92 idel10 = 0
93 gapmax = infinity
94 fpenmax = zero
95 is_available = .false.
96c--------------------------------------------------------
97c Read input fields
98c--------------------------------------------------------
99card1
100 CALL hm_get_intv ('secondaryentityids' ,ISU1 ,IS_AVAILABLE, LSUBMODEL)
101 CALL HM_GET_INTV ('mainentityids' ,ISU2 ,IS_AVAILABLE, LSUBMODEL)
102 CALL HM_GET_INTV ('noddel10' ,IDEL10 ,IS_AVAILABLE, LSUBMODEL)
103card2
104 CALL HM_GET_FLOATV('type10_scale' ,STFAC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
105 CALL HM_GET_FLOATV('gap' ,GAP ,IS_AVAILABLE, LSUBMODEL, UNITAB)
106 CALL HM_GET_FLOATV('tstart' ,STARTT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
107 CALL HM_GET_FLOATV('tstop' ,STOPT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
108card2
109 CALL HM_GET_INTV ('itied' ,ITIED ,IS_AVAILABLE, LSUBMODEL)
110 CALL HM_GET_INTV ('inactiv' ,INACTI ,IS_AVAILABLE, LSUBMODEL)
111 CALL HM_GET_FLOATV('stiff_dc' ,VISC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
112 CALL HM_GET_FLOATV('sort_fact' ,BUMULT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
113c--------------------------------------------------------
114c Checks
115c--------------------------------------------------------
116 IF (INACTI == 5) CALL ANCMSG(MSGID=1162,
117 . MSGTYPE=MSGERROR,
118 . ANMODE=ANINFO,
119 . I1=NOINT,
120 . C1=TITR)
121c
122 IS1 = 2 ! SECONDARY surface input by node group
123 IS2 = 1 ! main surface input by surface Id
124 INGR2USR => IGRNOD(1:NGRNOD)%ID
125 IF (ISU1 /= 0) ISU1 = NGR2USR(ISU1,INGR2USR,NGRNOD)
126 INGR2USR => IGRSURF(1:NSURF)%ID
127 ISU2 = NGR2USR(ISU2,INGR2USR,NSURF)
128 IF (IDEL10 < 0) THEN
129 IDELKEEP=1
130 IDEL10 = ABS(IDEL10)
131 END IF
132.OR. IF (IDEL10 > 2 N2D == 1) IDEL10 = 0
133c
134 FRIC = ITIED
135 IF (STFAC == ZERO) STFAC = ONE_FIFTH
136 IF (VISC == ZERO) VISC = FIVEEM2
137 IF (BUMULT == ZERO) BUMULT = BMUL0
138 IF (STOPT == ZERO) STOPT = INFINITY
139c--------------------------------------------------------
140c Fill interface buffers
141c--------------------------------------------------------
142 FRIGAP(1) = FRIC
143 FRIGAP(2) = GAP
144 FRIGAP(3) = STARTT
145 FRIGAP(4) = BUMULT
146 FRIGAP(10) = ZERO ! only in engine for storing number of couples candidates
147 FRIGAP(11) = STOPT
148 FRIGAP(14) = VISC
149 FRIGAP(16) = GAPMAX
150 FRIGAP(27) = FPENMAX
151 FRIGAP(15) = ZERO
152c
153 IPARI(7) = NTYP
154 IPARI(11) = 0
155 IPARI(17) = IDEL10
156 IPARI(13) = IS1*10 + IS2
157 IPARI(20) = ILEV
158 IPARI(21) = IGAP
159 IPARI(22) = INACTI
160 IPARI(65) = 0
161 IPARI(15) = NOINT
162 IPARI(23) = MULTIMP
163 IPARI(45) = ISU1
164 IPARI(46) = ISU2
165 IPARI(61) = IDELKEEP
166c--------------------------------------------------------
167c Printout
168c--------------------------------------------------------
169 ITIED = NINT(FRIC)
170 WRITE(IOUT,1510) ITIED,STFAC,GAP,STARTT,STOPT,
171 . BUMULT,INACTI,VISC,MULTIMP
172c
173 IF (IDEL10 /= 0) THEN
174 WRITE(IOUT,'(a,a,i5/)')
175 .' deletion flag on failure of main element',
176 .' (1:yes-all/2:yes-any) set to ',IDEL10
177 IF (IDELKEEP == 1) THEN
178 WRITE(IOUT,'(a)')
179 .' idel: DO not remove non-connected nodes from secondary surface'
180 ENDIF
181 ENDIF
182 WRITE(IOUT,'(6x,a)')'secondary surface input by nodes'
183 WRITE(IOUT,'(6x,a)')'main surface input by segments'
184
185c--------------------------------------------------------
186 1510 FORMAT(//
187 . ' TYPE 10 tied - auto impacting ' //,
188 . ' itied . . . . . . . . . . . . . . . . . . . ',I1/,
189 . ' 0: tied during impact - rebound autorized'/,
190 . ' 1: tied after impact no rebound autorized'/,
191 . ' stiffness factor. . . . . . . . . . . . . ',1PG20.13/,
192 . ' minimum gap . . . . . . . . . . . . . . . ',1PG20.13/,
193 . ' start time. . . . . . . . . . . . . . . . ',1PG20.13/,
194 . ' stop time . . . . . . . . . . . . . . . . ',1PG20.13/,
195 . ' bucket factor . . . . . . . . . . . . . . ',1PG20.13/,
196 . ' de-activation of initial penetrations . . ',I10/,
197 . ' critical damping factor . . . . . . . . . ',1PG20.13/,
198 . ' mean possible number of impact/node . . . ',I5/)
199c-----------
200 RETURN
201 END
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_read_inter_type10(ipari, stfac, frigap, igrnod, igrsurf, lsubmodel, unitab, titr, noint)
integer, parameter nchartitle
int main(int argc, char *argv[])