OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type14.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type14 (ipari, stfac, frigap, noint, igrnod, igrsurf, npc, titr, lsubmodel, unitab)

Function/Subroutine Documentation

◆ hm_read_inter_type14()

subroutine hm_read_inter_type14 ( integer, dimension(*) ipari,
stfac,
frigap,
integer noint,
type (group_), dimension(ngrnod), target igrnod,
type (surf_), dimension(nsurf), target igrsurf,
integer, dimension(*) npc,
character(len=nchartitle), intent(in) titr,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (unit_type_), intent(in) unitab )

Definition at line 36 of file hm_read_inter_type14.F.

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,I,J,L, 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--------------------------------------------------------------
263 1000 FORMAT(/1X,' INTERFACE number :',I10,1X,A)
264C------------
265 RETURN
266
267
268 1514 FORMAT(//
269 . ' type==14 node to surface ' //,
270 . ' INTERFACE stiffness . . . . . . . . . . . . ',1PG20.13/,
271 . ' FUNCTION for elastic contact . . . . . . . ',I10/,
272 . ' friction coefficient . . . . . . . . . . . ',1PG20.13/,
273 . ' function for friction . . . . . . . . . . . ',I10/,
274 . ' normal damping factor . . . . . . . . . . . ',1PG20.13/,
275 . ' function for damping versus velocity . . . ',I10/,
276 . ' function for damping versus elastic force . ',I10/,
277 . ' minimum gap . . . . . . . . . . . . . . . . ',1PG20.13/,
278 . ' start time. . . . . . . . . . . . . . . . . ',1PG20.13/,
279 . ' stop time . . . . . . . . . . . . . . . . . ',1PG20.13/)
280
my_real
#define my_real
Definition cppsort.cpp:32
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_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841