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

◆ 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 190 of file inintr_orthdirfric.F.

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