OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type14.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_type14 ../starter/source/interfaces/int14/hm_read_inter_type14.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!|| message_mod ../starter/share/message_module/message_mod.f
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_read_inter_type14(
37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 2 IGRNOD ,IGRSURF ,NPC ,TITR ,LSUBMODEL,
39 3 UNITAB )
40C============================================================================
41C
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE groupdef_mod
47 USE submodel_mod
48 USE unitab_mod
49 USE names_and_titles_mod , ONLY : nchartitle
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NOINT
61 INTEGER IPARI(*),NPC(*)
62 my_real STFAC
63 my_real frigap(*)
64 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
65 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
66 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
67C-----------------------------------------------
68 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
69 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com04_c.inc"
74#include "units_c.inc"
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 CHARACTER(LEN=NCHARTITLE) :: TITR1
79 INTEGER ISU1,ISU2, NTYP,IS1, IS2,NLO,NFRIC,NDAMP1,NDAMP2,NCURS,ISU20,INTKG
80 my_real FRIC,GAP,STARTT,STOPT,VISC
81 INTEGER, DIMENSION(:), POINTER :: INGR2USR
82 LOGICAL IS_AVAILABLE
83C-----------------------------------------------
84C E x t e r n a l F u n c t i o n s
85C-----------------------------------------------
86 INTEGER NGR2USR
87C-----------------------------------------------
88C=======================================================================
89C READING PENALTY INTERFACE /INTER/TYPE14
90C=======================================================================
91
92C Initializations
93 is1=0
94 is2=0
95 nlo = 0
96 nfric = 0
97 ndamp1 = 0
98 ndamp2 = 0
99 intkg=0
100C
101 fric = zero
102 gap = zero
103 startt = zero
104 stopt=ep30
105 visc = zero
106C
107 ntyp = 14
108 ipari(15)=noint
109 ipari(7)=ntyp
110
111 is_available = .false.
112C--------------------------------------------------
113C EXTRACT DATAS (INTEGER VALUES)
114C--------------------------------------------------
115 CALL hm_get_intv('secondaryentityids',isu1,is_available,lsubmodel)
116 CALL hm_get_intv('mainentityids',isu2,is_available,lsubmodel)
117 CALL hm_get_intv('Iload',nlo,is_available,lsubmodel)
118 CALL hm_get_intv('IFRIC',nfric,is_available,lsubmodel)
119 CALL hm_get_intv('FUN_A1',ndamp1,is_available,lsubmodel)
120 CALL hm_get_intv('FUN_A2',ndamp2,is_available,lsubmodel)
121C--------------------------------------------------
122C EXTRACT DATAS (REAL VALUES)
123C--------------------------------------------------
124 CALL hm_get_floatv('STIFF1',stfac,is_available,lsubmodel,unitab)
125 CALL hm_get_floatv('FRIC',fric,is_available,lsubmodel,unitab)
126 CALL hm_get_floatv('VISC',visc,is_available,lsubmodel,unitab)
127 CALL hm_get_floatv('GAP',gap,is_available,lsubmodel,unitab)
128C
129C....* CHECKS *.............
130
131 is1=2
132 is2=4
133 ingr2usr => igrnod(1:ngrnod)%ID
134 IF(isu1/=0)isu1=ngr2usr(isu1,ingr2usr,ngrnod)
135 isu20=isu2
136 ingr2usr => igrsurf(1:nsurf)%ID
137 isu2=ngr2usr(isu2,ingr2usr,nsurf)
138 IF ( igrsurf(isu2)%TYPE/=100
139 . .AND.igrsurf(isu2)%TYPE/=101) THEN
140 titr1 = igrsurf(isu20)%TITLE
141 CALL ancmsg(msgid=111,
142 . msgtype=msgerror,
143 . anmode=aninfo,
144 . i1=noint,
145 . c1=titr,
146 . i2=isu20,
147 . c2=titr1)
148 END IF
149C-----
150
151 IF (nlo==0) GOTO 11
152 DO ncurs=1,nfunct
153 IF (nlo==npc(nfunct+1+ncurs)) THEN
154 ipari(8)=ncurs
155 GOTO 11
156 ENDIF
157 ENDDO
158 CALL ancmsg(msgid=113,
159 . msgtype=msgerror,
160 . anmode=aninfo,
161 . i1=noint,
162 . c1=titr,
163 . i2=nlo)
164 11 CONTINUE
165 IF (nfric==0) GOTO 12
166 DO ncurs=1,nfunct
167 IF (nfric==npc(nfunct+1+ncurs)) THEN
168 ipari(9)=ncurs
169 GOTO 12
170 ENDIF
171 ENDDO
172 CALL ancmsg(msgid=113,
173 . msgtype=msgerror,
174 . anmode=aninfo,
175 . i1=noint,
176 . c1=titr,
177 . i2=nfric)
178 12 CONTINUE
179 IF (ndamp1==0) GOTO 13
180 DO ncurs=1,nfunct
181 IF (ndamp1==npc(nfunct+1+ncurs)) THEN
182 ipari(10)=ncurs
183 GOTO 13
184 ENDIF
185 ENDDO
186 CALL ancmsg(msgid=113,
187 . msgtype=msgerror,
188 . anmode=aninfo,
189 . i1=noint,
190 . c1=titr,
191 . i2=ndamp1)
192 13 CONTINUE
193 IF (ndamp2==0) GOTO 14
194 DO ncurs=1,nfunct
195 IF (ndamp2==npc(nfunct+1+ncurs)) THEN
196 ipari(11)=ncurs
197 GOTO 14
198 ENDIF
199 ENDDO
200 CALL ancmsg(msgid=113,
201 . msgtype=msgerror,
202 . anmode=aninfo,
203 . i1=noint,
204 . c1=titr,
205 . i2=ndamp2)
206 14 CONTINUE
207
208C.......* Storage IPARI FRIGAP *........
209 ipari(45)=isu1
210 ipari(46)=isu2
211 ipari(13)=is1*10+is2
212C
213 startt=zero
214 stopt =ep30
215C
216C.....* Storage IPARI FRIGAP *.......
217 frigap(1)=fric
218 frigap(2)=gap
219 frigap(3)=startt
220 frigap(11)=stopt
221 frigap(14)=visc
222
223C------------------------------------------------------------
224C General Storage IPARI FRIGAP
225C------------------------------------------------------------
226 ipari(65) = intkg
227C------------------------------------------------------------
228C PRINTOUT
229C------------------------------------------------------------
230C
231 WRITE(iout,1514)
232 . stfac,nlo,fric,nfric,visc,ndamp1,ndamp2,gap,
233 . startt,stopt
234
235C--------------------------------------------------------------
236 IF(is1==0)THEN
237 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
238 ELSEIF(is1==1)THEN
239 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
240 ELSEIF(is1==2)THEN
241 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
242 ELSEIF(is1==3)THEN
243 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
244 ELSEIF(is1==4 )THEN
245 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
246 ELSEIF(is1==5 )THEN
247 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
248 ENDIF
249 IF(is2==0)THEN
250 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
251 ELSEIF(is2==1)THEN
252 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
253 ELSEIF(is2==2)THEN
254 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
255 ELSEIF(is2==3)THEN
256 WRITE(iout,'(6X,A)')'main surface input by segments'
257 ELSEIF(IS2==4)THEN
258 WRITE(IOUT,'(6x,a)')'main surface refers ',
259 . 'to hyper-ellipsoidal surface'
260 ENDIF
261C
262C--------------------------------------------------------------
263C------------
264 RETURN
265
266
267 1514 FORMAT(//
268 . ' type==14 node to surface ' //,
269 . ' INTERFACE stiffness . . . . . . . . . . . . ',1PG20.13/,
270 . ' FUNCTION for elastic contact . . . . . . . ',I10/,
271 . ' friction coefficient . . . . . . . . . . . ',1PG20.13/,
272 . ' function for friction . . . . . . . . . . . ',I10/,
273 . ' normal damping factor . . . . . . . . . . . ',1PG20.13/,
274 . ' function for damping versus velocity . . . ',I10/,
275 . ' function for damping versus elastic force . ',I10/,
276 . ' minimum gap . . . . . . . . . . . . . . . . ',1PG20.13/,
277 . ' start time. . . . . . . . . . . . . . . . . ',1PG20.13/,
278 . ' stop time . . . . . . . . . . . . . . . . . ',1PG20.13/)
279
280 END
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
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_type14
subroutine hm_read_inter_type14(ipari, stfac, frigap, noint, igrnod, igrsurf, npc, titr, lsubmodel, unitab)
Definition hm_read_inter_type14.F:40
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29