OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type22.F File Reference
#include "implicit_f.inc"
#include "scr06_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "inter22.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inter_type22 (ipari, stfac, frigap, noint, igrnod, igrsurf, igrbric, igrsh3n, igrtruss, fric_p, titr, lsubmodel, npari, nparir)

Function/Subroutine Documentation

◆ hm_read_inter_type22()

subroutine hm_read_inter_type22 ( integer, dimension(npari) ipari,
stfac,
frigap,
integer noint,
type (group_), dimension(ngrnod), target igrnod,
type (surf_), dimension(nsurf), target igrsurf,
type (group_), dimension(ngrbric), target igrbric,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrtrus) igrtruss,
fric_p,
character(len=nchartitle), intent(in) titr,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel,
integer, intent(in) npari,
integer, intent(in) nparir )
Parameters
[in]nparirarray sizes

Definition at line 35 of file hm_read_inter_type22.F.

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 names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
48C-----------------------------------------------
49C I m p l i c i t T y p e
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER,INTENT(IN) :: NPARI, NPARIR !< array sizes
56 INTEGER ISU1,ISU2,NOINT
57 INTEGER IPARI(NPARI)
58 my_real stfac
59 my_real frigap(nparir),fric_p(10)
60 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
61C-----------------------------------------------
62 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
63 TYPE (GROUP_) ,TARGET, DIMENSION(NGRBRIC) :: IGRBRIC
64 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
65 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
66 TYPE (SURF_) ,TARGET , DIMENSION(NSURF) :: IGRSURF
67 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "scr06_c.inc"
72#include "com01_c.inc"
73#include "com04_c.inc"
74#include "units_c.inc"
75#include "inter22.inc"
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER J, NTYP, IBID,INACTI,IGSTI, IVIS2,ILEV,INTKG,
80 . IS1, IS2, IGAP,MULTIMP,I22GRSH3N,I22GRNOD,
81 . INTTH,I22LEN1,I22GRTRUS,I22GRNOD2,I22GRNOD3
82 my_real :: fric,gap,startt,bumult,stopt,visc,viscf,ratio22_
83 LOGICAL LOGI_I22GRSH3N, LOGI_I22GRTRUS,LOGI_I22GRNOD
84 LOGICAL IS_AVAILABLE
85 INTEGER, DIMENSION(:), POINTER :: INGR2USR
86C-----------------------------------------------
87C E x t e r n a l F u n c t i o n s
88C-----------------------------------------------
89 INTEGER NGR2USR
90C=======================================================================
91C READING ALE INTERFACE /INTER/TYPE22
92C=======================================================================
93C Initializations
94 is1=0
95 is2=0
96 ilev=0
97 intkg =0
98 ntyp = 22
99 ipari(15)=noint
100 ipari(7)=ntyp
101 is_available=.false.
102C------------------------------------------------------------
103C Card1
104C------------------------------------------------------------
105
106 CALL hm_get_intv('grbric_ID', isu1, is_available, lsubmodel)
107 CALL hm_get_intv('surf_ID', isu2, is_available, lsubmodel)
108 i22grsh3n=0
109 i22grtrus=0
110 i22grnod=0
111 i22grnod2=0
112 i22grnod3=0
113 ioutp22=0
114 ibid=0
115C
116C....* CHECKS *.............
117C
118 !IF main side is not given
119 IF(isu2==0) THEN
120 CALL ancmsg(msgid=119,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr)
121 is2=0
122 ELSE
123 is2=1
124 ingr2usr => igrsurf(1:nsurf)%ID
125 isu2=ngr2usr(isu2,ingr2usr,nsurf)
126 ENDIF
127
128 !common value : IOUTP22
129 IF(ioutp22==0)THEN
130 ioutp22=1
131 ELSEIF(ioutp22/=1)THEN
132 ioutp22=0
133 ENDIF
134
135 ! IF SECONDARY ID SIDE IS GIVEN
136 IF(isu1/=0)THEN
137 ingr2usr => igrbric(1:ngrbric)%ID
138 isu1=ngr2usr(isu1,ingr2usr,ngrbric)
139 is1 =4
140 ELSE
141 CALL ancmsg(msgid=114,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr)
142 is1 =0
143 ENDIF
144C
145C------------------------------------------------------------
146C Card2
147C------------------------------------------------------------
148 !=======================================================!
149 ! TEMPORARY : flags for equivalent type7 interface !
150 !=======================================================!
151
152 jmult22=zero
153 ratio22_=zero
154
155C
156C.....* CHECK AND Storage IPARI FRIGAP *.........
157C
158
159 ipari(13)=is1*10+is2
160 ipari(45)=isu1
161 ipari(46)=isu2
162C
163
164 IF(jmult22==zero)jmult22=one
165 IF(ratio22_ == zero)ratio22_ = one + ten/hundred
166 ratio22 = min(ratio22,ratio22_)
167 gap = zero
168 igsti = 0
169 intth = 0
170 igap = 0
171 multimp = 0
172 ntyp = 22
173 startt = zero
174 stopt = zero
175 ivis2 = 0
176 inacti = 0
177 visc = zero
178 viscf = zero
179 bumult = zero
180 stfac = one
181 visc = fiveem2
182 frigap(14) = visc
183 frigap(16) = ep30
184 frigap(27) = one
185 frigap(28) = zero
186 frigap(24) = one
187 frigap(25) = one
188 frigap(20) = one/ep30
189 frigap(21) = one
190 frigap(22) = ratio22_
191 ipari(39) = 0
192 ipari(40) = 0
193 ipari(41) = 0
194 ipari(34) = 0
195 ipari(47) = 0
196 fric = zero
197 fric_p(1) = zero
198 fric_p(2) = zero
199 fric_p(3) = zero
200 fric_p(4) = zero
201 fric_p(5) = zero
202 fric_p(6) = zero
203 ipari(17) = 0
204 ipari(14) = 0
205 ipari(30) = 0
206 ipari(31) = 0
207 ipari(32) = 0
208 ipari(44) = 0
209 ipari(48) = i22grsh3n
210 ipari(49) = 0 !reserved GRSH3N ---> sh3n group identifier
211 ipari(50) = 0 !reserved GRSH3N ---> sh3n group NEL
212 ipari(51) = i22grtrus
213 ipari(52) = 0 !reserved GRTRUS ---> truss group identifier
214 ipari(53) = 0 !reserved GRTRUS ---> truss group NEL
215 ipari(35) = ioutp22
216 ipari(34) = i22grnod !orphan nodes
217 ipari(36) = i22grnod2 !orphan nodes
218 ipari(19) = i22grnod3
219 ipari(70) = 0 !reserved GRNOD_IID !iad0 renumbered after ddsplit so retrieve it in engine from group internal id
220 ipari(81) = 0 !reserved GRNOD_IID !iad0 renumbered after ddsplit so retrieve it in engine from group internal id
221 ipari(82) = 0 !reserved GRNOD_IID !iad0 renumbered after ddsplit so retrieve it in engine from group internal id
222 !IGR3SHN flag
223 !
224 ! IGRN(1,I) : IDENTIFICATEUR DE GROUP
225 ! IGRN(2,I) : NOMBRE DE NOEUDS
226 ! IGRN(3,I) : ADRESSE DES NOEUDS DANS IBUFSSG
227 ! IGRN(4,I) : TYPE (0 POUR NOEUDS, 1 BRIC, 2 QUAD, 3 SHELL,
228 ! 4 TRUSS, 5 BEAM, 6 SPRINGS,7 SHELL_3N)
229 !
230 logi_i22grsh3n = .false.
231 DO j = 1,ngrsh3n
232 IF (igrsh3n(j)%ID == i22grsh3n) THEN
233 ipari(49) = j ! J is the sh3n group number.
234 ipari(50) = igrsh3n(j)%NENTITY
235 logi_i22grsh3n = .true.
236 EXIT
237 END IF
238 END DO
239 IF( (i22grsh3n /=0) .AND. (logi_i22grsh3n .EQV. .false.))THEN
240 i22grsh3n = 0
241 ipari(48:50) = 0
242c print *, "WARNING : INTER22, GRSH3N ID NOT FOUND IN INPUT FILE"
243 ENDIF
244
245 logi_i22grtrus = .false.
246 DO j = 1,ngrtrus
247 IF (igrtruss(j)%ID == i22grtrus) THEN
248 ipari(52) = j
249 ipari(53) = igrtruss(j)%NENTITY
250 logi_i22grtrus = .true.
251 EXIT
252 END IF
253 END DO
254 IF( (i22grtrus /=0) .AND. (logi_i22grtrus .EQV. .false.))THEN
255 i22grtrus = 0
256 ipari(51:53) = 0
257c print *, "WARNING : INTER22, GRTRUS ID NOT FOUND IN INPUT FILE"
258 ENDIF
259
260 logi_i22grnod = .false.
261 DO j = 1,ngrnod
262 IF (igrnod(j)%ID == i22grnod) THEN
263 ipari(70) = j
264 logi_i22grnod = .true.
265 !WRITE(*,*)"IAD0,NODES", IPARI(35),IPARI(44)
266 EXIT
267 END IF
268 END DO
269 IF( (i22grnod /=0) .AND. (logi_i22grnod .EQV. .false.))THEN
270 i22grnod = 0
271 ipari(70) = 0
272c print *, "WARNING : INTER22, GRNOD ID NOT FOUND IN INPUT FILE"
273 ENDIF
274 !-------------!
275 logi_i22grnod = .false.
276 DO j = 1,ngrnod
277 IF (igrnod(j)%ID == i22grnod2) THEN
278 ipari(81) = j
279 logi_i22grnod = .true.
280 !WRITE(*,*)"IAD0,NODES", IPARI(35),IPARI(44)
281 EXIT
282 END IF
283 END DO
284 IF( (i22grnod2 /=0) .AND. (logi_i22grnod .EQV. .false.))THEN
285 i22grnod2 = 0
286 ipari(81) = 0
287c print *, "WARNING : INTER22, GRNOD ID NOT FOUND IN INPUT FILE"
288 ENDIF
289 !-------------!
290 logi_i22grnod = .false.
291 DO j = 1,ngrnod
292 IF (igrnod(j)%ID == i22grnod3) THEN
293 ipari(82) = j
294 logi_i22grnod = .true.
295 !!!!WRITE(*,*)"IAD0,NODES", IPARI(35),IPARI(44)
296 EXIT
297 END IF
298 END DO
299 IF( (i22grnod3 /=0) .AND. (logi_i22grnod .EQV. .false.))THEN
300 i22grnod3 = 0
301 ipari(82) = 0
302c print *, "WARNING : INTER22, GRNOD ID NOT FOUND IN INPUT FILE"
303 ENDIF
304 !-------------!
305
306 kcontact =max(kcontact,0,0)
307 intbag = max(intbag,0)
308
309 IF(is1*is2/=0)THEN
310 int22 = int22 + 1 !number of int22 interfaces.
311 i22len1 = max(100 ,nint(82*igrbric(isu1)%NENTITY**half))
312 i22len1 = min(i22len1 ,igrbric(isu1)%NENTITY)
313 i22len1 = nint(jmult22*i22len1)
314 i22len = max( i22len , i22len1 ) !maximum nb of 3D elem.
315 ENDIF
316
317 !print *, "INTER22 BUFFER LENGTH, I22LEN =", I22LEN
318 !print *, "INTER22 GRBRICK SIZE =", IGRN(2,ISU1)
319
320C------------------------------------------------------------
321C General Storage IPARI FRIGAP
322C------------------------------------------------------------
323 ipari(65) = intkg
324
325 ipari(20)=ilev
326 ipari(21)=igap
327 ipari(22)=inacti
328
329 frigap(1)=fric
330 frigap(2)=gap
331 frigap(3)=startt
332 IF (stopt == zero) stopt = ep30
333 frigap(11)=stopt
334C BUMULT is increased for big models
335 IF(bumult==zero) THEN
336 bumult = bmul0
337 IF(numnod > 2500000) THEN
338 bumult = bmul0*two
339 ELSEIF(numnod > 1500000) THEN
340 bumult = bmul0*three/two
341 END IF
342 END IF
343 frigap(4)=bumult
344
345C FRIGAP(10) is initialized but used only in engine for storing number of couples candidates
346 frigap(10)=float(0)
347
348 multimp = 4
349 ipari(23)=multimp
350C
351C------------------------------------------------------------
352C PRINTOUT
353C------------------------------------------------------------
354C
355
356 IF(i22grsh3n>0)WRITE(iout,2207)i22grsh3n, i22grtrus,i22grnod
357
358C--------------------------------------------------------------
359 IF(is1==0)THEN
360 WRITE(iout,'(6X,A)')'NO SECONDARY SURFACE INPUT'
361 ELSEIF(is1==1)THEN
362 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
363 ELSEIF(is1==2)THEN
364 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY NODES'
365 ELSEIF(is1==3)THEN
366 WRITE(iout,'(6X,A)')'SECONDARY SURFACE INPUT BY SEGMENTS'
367 ELSEIF(is1==4 )THEN
368 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY BRICKS'
369 ELSEIF(is1==5 )THEN
370 WRITE(iout,'(6X,A)')'SECONDARY SIDE INPUT BY SOLID ELEMENTS'
371 ENDIF
372 IF(is2==0)THEN
373 WRITE(iout,'(6X,A)')'NO MAIN SURFACE INPUT'
374 ELSEIF(is2==1)THEN
375 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
376 ELSEIF(is2==2)THEN
377 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY NODES'
378 ELSEIF(is2==3)THEN
379 WRITE(iout,'(6X,A)')'MAIN SURFACE INPUT BY SEGMENTS'
380 ELSEIF(is2==4)THEN
381 WRITE(iout,'(6x,a)')'main surface refers ',
382 . 'to hyper-ellipsoidal surface'
383 ENDIF
384C
385C--------------------------------------------------------------
386
387C------------
388 RETURN
389
390 2207 FORMAT(//
391 . ' type==22 fsi INTERFACE ' //,
392 . ' grsh3n_id. . . . . . . . . . . . . . . . . . ',I10/,
393 . ' grtrus_id. . . . . . . . . . . . . . . . . . ',I10/,
394 . ' grnod_id . . . . . . . . . . . . . . . . . . ',I10/)
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:712
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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:889