OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintr_orthdirfric.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inintr_orthdirfric (ipari, intbuf_tab, intbuf_fric_tab, igeo, geo, x, ixtg, ixc, iparttg, ipartc, pfricorth, irepforth, phiforth, vforth, knod2elc, knod2eltg, nod2eltg, nod2elc, iworksh, pm, pm_stack, thk, skew, itab, ipart)
subroutine orthdir_proj (i, vx, vy, vz, phi, irep, x, irectm, itab, dir_fricm, ip, ipart)

Function/Subroutine Documentation

◆ inintr_orthdirfric()

subroutine inintr_orthdirfric ( integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(intbuf_fric_struct_), dimension(*) intbuf_fric_tab,
integer, dimension(npropgi,*) igeo,
geo,
x,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixc,*) ixc,
integer, dimension(*) iparttg,
integer, dimension(*) ipartc,
integer, dimension(*) pfricorth,
integer, dimension(*) irepforth,
phiforth,
vforth,
integer, dimension(*) knod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2eltg,
integer, dimension(*) nod2elc,
integer, dimension(3,*) iworksh,
pm,
pm_stack,
thk,
skew,
integer, dimension(*) itab,
integer, dimension(lipart1,*) ipart )

Definition at line 33 of file inintr_orthdirfric.F.

39!IDFRICORIENT,TITFRICORIENT,
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE intbufdef_mod
45 USE intbuf_fric_mod
46 use element_mod , only : nixc,nixtg
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "scr17_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER IPARI(NPARI,*), IPARTTG(*), IPARTC(*) ,
61 . IXC(NIXC,*), IXTG(NIXTG,*),IPART(LIPART1,*) ,
62 . IREPFORTH(*), PFRICORTH(*),IGEO(NPROPGI,*),ITAB(*),
63 . KNOD2ELC(*), KNOD2ELTG(*), NOD2ELC(*), NOD2ELTG(*),
64 . IWORKSH(3,*)
65c . IDFRICORIENT(*),
66 my_real x(3,*), phiforth(*), vforth(3,*) ,geo(npropg,*),pm(npropm,*),
67 . pm_stack(20,*) ,thk(*) ,skew(lskew,*)
68 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
69 TYPE(INTBUF_FRIC_STRUCT_) INTBUF_FRIC_TAB(*)
70
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER N ,NIF ,IREP ,NLAY ,IORTH ,IE ,NRTM ,I ,NELTG ,NELC ,STAT ,
75 . NRT_SH,J,INRT ,NTY ,IL ,N3 ,N4 ,IP ,IPORTH , IGTYP ,ID ,ISU2 ,ILEV ,ISU1,NRT1,NRT2,NSHIF,
76 . PID ,ISK
77 my_real
78 . vx ,vy ,vz ,e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
79 . rx ,ry ,rz ,sx ,sy ,sz ,suma ,s1 ,s2 ,vr ,vs ,cp , sp ,
80 . aa ,bb ,d1 ,d2 ,s ,det ,phi ,u1x ,u1y ,u2x ,u2y ,w1x ,w1y ,w2x ,w2y ,
81 . torth , sum
82C-----------------------------------------------
83
84C----
85 DO n=1,ninter
86 nty =ipari(7,n)
87 IF(nty == 7.OR.nty==24.OR.nty==25) THEN
88 nif = ipari(72,n)
89 IF(nif > 0) THEN
90 iorth = intbuf_fric_tab(nif)%IORTHFRIC
91 IF(iorth > 0 ) THEN
92 nrtm =ipari(4,n)
93 DO i=1,nrtm
94 nelc = 0
95 neltg = 0
96 CALL incoq3(intbuf_tab(n)%IRECTM,ixc ,ixtg ,n ,nelc ,
97 . neltg ,i ,geo ,pm ,knod2elc ,
98 . knod2eltg ,nod2elc ,nod2eltg,thk,nty,igeo,
99 . pm_stack , iworksh)
100
101 IF(neltg/=0) THEN
102 ip= iparttg(neltg)
103 ie = neltg
104 igtyp = igeo(11,ixtg(nixtg-1,ie))
105 pid = ixtg(nixtg-1,ie)
106 ELSE
107 ip= ipartc(nelc)
108 ie = nelc
109 igtyp = igeo(11,ixc(nixc-1,ie))
110 pid = ixc(nixc-1,ie)
111 ENDIF
112 IF(ie > 0) THEN
113 iporth = pfricorth(ip)
114C---1st Case : orthotropic directions are defined in /FRICTION/ORIENTATION for part IP
115
116 IF(iporth >0) THEN
117c
118 phi = phiforth(iporth)
119 irep = irepforth(iporth)
120
121 intbuf_tab(n)%IREP_FRICM(i) = irep
122 vx = vforth(1,iporth)
123 vy = vforth(2,iporth)
124 vz = vforth(3,iporth)
125
126 CALL orthdir_proj(
127 . i ,vx , vy ,vz , phi ,
128 . irep ,x ,intbuf_tab(n)%IRECTM,itab ,
129 . intbuf_tab(n)%DIR_FRICM,ip ,ipart )
130c
131C---2nd Case : Friction orthotropic directions same as property
132
133 ELSEIF(igtyp == 9.OR.igtyp==10.OR.igtyp==11.OR.igtyp==17.OR.igtyp==51.OR.igtyp==52) THEN
134c
135 irep = igeo(6,pid)
136 intbuf_tab(n)%IREP_FRICM(i) = irep
137
138 intbuf_tab(n)%IREP_FRICM(i) = irep
139 IF(igtyp==9.OR.igtyp==10) THEN
140 isk = 0
141 ELSE
142 isk = igeo(2,pid)
143 ENDIF
144 IF(isk==0) THEN
145 vx = geo(7,pid)
146 vy = geo(8,pid)
147 vz = geo(9,pid)
148 ELSE
149 vx = skew(1,isk)
150 vy = skew(2,isk)
151 vz = skew(3,isk)
152 ENDIF
153 nlay = igeo(15,pid)
154 IF(nlay == 1) THEN
155 phi = geo(10,pid)
156 ELSE
157 il = iabs(nlay)/2 + 1
158 phi =geo(200+il,pid)
159 ENDIF
160
161 CALL orthdir_proj(
162 . i ,vx , vy ,vz , phi ,
163 . irep ,x ,intbuf_tab(n)%IRECTM,itab ,
164 . intbuf_tab(n)%DIR_FRICM,ip ,ipart )
165c
166C---3rd Case : Isotropic friction
167 ELSE
168 intbuf_tab(n)%IREP_FRICM(i) = 10
169c
170 ENDIF
171 ENDIF
172 ENDDO
173 ENDIF
174 ENDIF
175 ENDIF
176 ENDDO
177
178C-----------
179 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
incoq3
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
Definition incoq3.F:46
orthdir_proj
subroutine orthdir_proj(i, vx, vy, vz, phi, irep, x, irectm, itab, dir_fricm, ip, ipart)
Definition inintr_orthdirfric.F:195
message_mod
Definition message_mod.F:1257

◆ orthdir_proj()

subroutine orthdir_proj ( integer i,
vx,
vy,
vz,
phi,
integer irep,
x,
integer, dimension(4,*) irectm,
integer, dimension(*) itab,
dir_fricm,
integer ip,
integer, dimension(lipart1,*) ipart )

Definition at line 191 of file inintr_orthdirfric.F.

195C-----------------------------------------------
196C M o d u l e s
197C-----------------------------------------------
198 USE message_mod
199C-----------------------------------------------
200C I m p l i c i t T y p e s
201C-----------------------------------------------
202#include "implicit_f.inc"
203C-----------------------------------------------
204C C o m m o n B l o c k s
205C-----------------------------------------------
206#include "scr17_c.inc"
207C-----------------------------------------------
208C D u m m y A r g u m e n t s
209C-----------------------------------------------
210 INTEGER
211 . I ,IREP ,IP ,
212 . IRECTM(4,*),ITAB(*),IPART(LIPART1,*)
213 my_real vx ,vy ,vz ,phi ,x(3,*), dir_fricm(2,*)
214
215C-----------------------------------------------
216C L o c a l V a r i a b l e s
217C-----------------------------------------------
218 INTEGER N1 ,N2,N3 ,N4
219 my_real
220 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
221 . rx ,ry ,rz ,sx ,sy ,sz ,suma ,s1 ,s2 ,vr ,vs ,cp , sp ,
222 . aa ,bb ,d1 ,d2 ,s ,det ,u1x ,u1y ,u2x ,u2y ,w1x ,w1y ,w2x ,w2y ,
223 . torth , sum ,v
224C-----------------------------------------------
225 n1 = irectm(1,i)
226 n2 = irectm(2,i)
227 n3 = irectm(3,i)
228 n4 = irectm(4,i)
229
230C--- Frame element:
231
232 IF (n3 /= n4) THEN
233C--- shell 4N
234 e1x= x(1,n2) + x(1,n3) - x(1,n1) - x(1,n4)
235 e1y= x(2,n2) + x(2,n3) - x(2,n1) - x(2,n4)
236 e1z= x(3,n2) + x(3,n3) - x(3,n1) - x(3,n4)
237
238 e2x= x(1,n3) + x(1,n4) - x(1,n1) - x(1,n2)
239 e2y= x(2,n3) + x(2,n4) - x(2,n1) - x(2,n2)
240 e2z= x(3,n3) + x(3,n4) - x(3,n1) - x(3,n2)
241
242 ELSE
243C--- shell 3N
244 e1x= x(1,n2) - x(1,n1)
245 e1y= x(2,n2) - x(2,n1)
246 e1z= x(3,n2) - x(3,n1)
247 e2x= x(1,n3) - x(1,n1)
248 e2y= x(2,n3) - x(2,n1)
249 e2z= x(3,n3) - x(3,n1)
250 ENDIF
251 rx = e1x
252 ry = e1y
253 rz = e1z
254 sx = e2x
255 sy = e2y
256 sz = e2z
257c
258 e3x = e1y*e2z-e1z*e2y
259 e3y = e1z*e2x-e1x*e2z
260 e3z = e1x*e2y-e1y*e2x
261
262 suma = e3x*e3x+e3y*e3y+e3z*e3z
263 suma = one/max(sqrt(suma),em20)
264 e3x = e3x*suma
265 e3y = e3y*suma
266 e3z = e3z*suma
267
268C
269 s1 = e1x*e1x+e1y*e1y+e1z*e1z
270 s2 = e2x*e2x+e2y*e2y+e2z*e2z
271 suma = sqrt(s1/s2)
272 e1x = e1x + (e2y *e3z-e2z*e3y)*suma
273 e1y = e1y + (e2z *e3x-e2x*e3z)*suma
274 e1z = e1z + (e2x *e3y-e2y*e3x)*suma
275
276 suma = e1x*e1x+e1y*e1y+e1z*e1z
277 suma = one/max(sqrt(suma),em20)
278 e1x = e1x*suma
279 e1y = e1y*suma
280 e1z = e1z*suma
281C
282 e2x = e3y * e1z - e3z * e1y
283 e2y = e3z * e1x - e3x * e1z
284 e2z = e3x * e1y - e3y * e1x
285
286C--- projection of V on element plane
287 v = vx*e3x + vy*e3y + vz*e3z
288 vx = vx-v*e3x
289 vy = vy-v*e3y
290 vz = vz-v*e3z
291 v =sqrt(vx*vx+vy*vy+vz*vz)
292 IF (v < em10) THEN
293 CALL ancmsg(msgid=1641,
294 . msgtype=msgerror,
295 . anmode=aninfo_blind_1,
296c . I1=ID,
297c . C1=TITR,
298 . i2=ipart(4,ip)) !
299 ENDIF
300
301 v= max(v,em20)
302
303 vx = vx / v
304 vy = vy / v
305 vz = vz / v
306
307C--- Projection of orthotropic axes
308
309 vr = vx*e1x+vy*e1y+vz*e1z
310 vs = vx*e2x+vy*e2y+vz*e2z
311
312 cp = cos(phi)
313 sp = sin(phi)
314
315 aa = vr*cp - vs*sp
316 bb = vs*cp + vr*sp
317
318 IF (irep == 1) THEN
319 u1x = rx*e1x+ry*e1y+rz*e1z
320 u1y = rx*e2x+ry*e2y+rz*e2z
321 u2x = sx*e1x+sy*e1y+sz*e1z
322 u2y = sx*e2x+sy*e2y+sz*e2z
323 det = u1x*u2y-u1y*u2x
324 w1x = u2y/det
325 w2y = u1x/det
326 w1y = -u1y/det
327 w2x = -u2x/det
328
329 d1 = aa
330 d2 = bb
331
332 aa = w1x*d1 + w2x*d2
333 bb = w1y*d1 + w2y*d2
334 s = sqrt(aa**2 + bb**2)
335 aa = aa/s
336 bb = bb/s
337 ENDIF
338
339 dir_fricm(1,i) = aa
340 dir_fricm(2,i) = bb
341
342C-----------
343 RETURN
max
#define max(a, b)
Definition macros.h:21
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