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

Go to the source code of this file.

Functions/Subroutines

subroutine s8ske3 (pm, geo, ixs, x, elbuf_str, nel, icp, icsig, etag, iddl, ndof, k_diag, k_lt, iadk, jdik, mpt, ipm, igeo, ikgeo, bufmat, nft, mtn, jhbe, jcvt, igtyp, isorth)

Function/Subroutine Documentation

◆ s8ske3()

subroutine s8ske3 ( pm,
geo,
integer, dimension(nixs,*) ixs,
x,
type (elbuf_struct_), target elbuf_str,
integer nel,
integer icp,
integer icsig,
integer, dimension(*) etag,
integer, dimension(*) iddl,
integer, dimension(*) ndof,
k_diag,
k_lt,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
integer mpt,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer ikgeo,
bufmat,
integer, intent(in) nft,
integer, intent(in) mtn,
integer, intent(in) jhbe,
integer, intent(in) jcvt,
integer, intent(in) igtyp,
integer, intent(in) isorth )

Definition at line 40 of file s8ske3.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
52 use element_mod , only : nixs
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com04_c.inc"
65#include "param_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER, INTENT(IN) :: NFT
70 INTEGER, INTENT(IN) :: MTN
71 INTEGER, INTENT(IN) :: JHBE
72 INTEGER, INTENT(IN) :: JCVT
73 INTEGER, INTENT(IN) :: IGTYP
74 INTEGER, INTENT(IN) :: ISORTH
75 INTEGER NEL ,ICP, ICSIG,IKGEO,MPT
76 INTEGER NDOF(*) ,IADK(*) ,JDIK(*),
77 . IXS(NIXS,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),ETAG(*),IDDL(*)
78C
79 my_real
80 . pm(npropm,*), geo(npropg,*), x(*),
81 . k11(9,mvsiz) , k12(9,mvsiz) ,k13(9,mvsiz) ,k14(9,mvsiz) ,
82 . k15(9,mvsiz) , k16(9,mvsiz) ,k17(9,mvsiz) ,k18(9,mvsiz) ,
83 . k22(9,mvsiz) ,k23(9,mvsiz) ,k24(9,mvsiz) ,k25(9,mvsiz) ,
84 . k26(9,mvsiz) ,k27(9,mvsiz) ,k28(9,mvsiz) ,k33(9,mvsiz) ,
85 . k34(9,mvsiz) ,k35(9,mvsiz) ,k36(9,mvsiz) ,k37(9,mvsiz) ,
86 . k38(9,mvsiz) ,k44(9,mvsiz) ,k45(9,mvsiz) ,k46(9,mvsiz) ,
87 . k47(9,mvsiz) ,k48(9,mvsiz) ,k55(9,mvsiz) ,k56(9,mvsiz) ,
88 . k57(9,mvsiz) ,k58(9,mvsiz) ,k66(9,mvsiz) ,k67(9,mvsiz) ,
89 . k68(9,mvsiz) ,k77(9,mvsiz) ,k78(9,mvsiz) ,k88(9,mvsiz) ,
90 . offg(mvsiz) ,bufmat(*) ,k_diag(*) ,k_lt(*)
91 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
92C-----------------------------------------------
93C L o c a l V a r i a b l e s
94C-----------------------------------------------
95 INTEGER NF1, I, J, IKORTH,
96 . IR, IS, IT,IL,IP,ICPG,NPTR,NPTS,NPTT,NLAY,
97 . IAD0,PID ,IJ,JJ,K
98 INTEGER MXT(MVSIZ), NGL(MVSIZ), NGEO(MVSIZ)
99 my_real
100 . voln(mvsiz)
101C----------------
102 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
103 . NC5(MVSIZ), NC6(MVSIZ), NC7(MVSIZ), NC8(MVSIZ)
104 my_real
105 . off(mvsiz) ,
106 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
107 . x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
108 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
109 . y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
110 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
111 . z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz)
112c
113 my_real
114 . wi,!NU(MVSIZ),
115 . volm(mvsiz),gama(mvsiz,6)
116 double precision
117 . kl(24,24,nel),ks(24,24,nel), trm(nel,24,24),
118 . dn_x(mvsiz,8),dn_y(mvsiz,8),dn_z(mvsiz,8),
119 . dn_r(8),dn_s(8),dn_t(8),invj(9,mvsiz),
120 . v1(mvsiz,9), v2(mvsiz,9), v3(mvsiz,9), v4(mvsiz,9),
121 . v5(mvsiz,9), v6(mvsiz,9), v7(mvsiz,9), v8(mvsiz,9)
122 TYPE(G_BUFEL_) ,POINTER :: GBUF
123 TYPE(L_BUFEL_) ,POINTER :: LBUF
124
125 my_real
126 . w_gauss(9,9),a_gauss(9,9)
127 DATA w_gauss /
128 1 2. ,0. ,0. ,
129 1 0. ,0. ,0. ,
130 1 0. ,0. ,0. ,
131 2 1. ,1. ,0. ,
132 2 0. ,0. ,0. ,
133 2 0. ,0. ,0. ,
134 3 0.555555555555556,0.888888888888889,0.555555555555556,
135 3 0. ,0. ,0. ,
136 3 0. ,0. ,0. ,
137 4 0.347854845137454,0.652145154862546,0.652145154862546,
138 4 0.347854845137454,0. ,0. ,
139 4 0. ,0. ,0. ,
140 5 0.236926885056189,0.478628670499366,0.568888888888889,
141 5 0.478628670499366,0.236926885056189,0. ,
142 5 0. ,0. ,0. ,
143 6 0.171324492379170,0.360761573048139,0.467913934572691,
144 6 0.467913934572691,0.360761573048139,0.171324492379170,
145 6 0. ,0. ,0. ,
146 7 0.129484966168870,0.279705391489277,0.381830050505119,
147 7 0.417959183673469,0.381830050505119,0.279705391489277,
148 7 0.129484966168870,0. ,0. ,
149 8 0.101228536290376,0.222381034453374,0.313706645877887,
150 8 0.362683783378362,0.362683783378362,0.313706645877887,
151 8 0.222381034453374,0.101228536290376,0. ,
152 9 0.081274388361574,0.180648160694857,0.260610696402935,
153 9 0.312347077040003,0.330239355001260,0.312347077040003,
154 9 0.260610696402935,0.180648160694857,0.081274388361574/
155 DATA a_gauss /
156 1 0. ,0. ,0. ,
157 1 0. ,0. ,0. ,
158 1 0. ,0. ,0. ,
159 2 -.577350269189626,0.577350269189626,0. ,
160 2 0. ,0. ,0. ,
161 2 0. ,0. ,0. ,
162 3 -.774596669241483,0. ,0.774596669241483,
163 3 0. ,0. ,0. ,
164 3 0. ,0. ,0. ,
165 4 -.861136311594053,-.339981043584856,0.339981043584856,
166 4 0.861136311594053,0. ,0. ,
167 4 0. ,0. ,0. ,
168 5 -.906179845938664,-.538469310105683,0. ,
169 5 0.538469310105683,0.906179845938664,0. ,
170 5 0. ,0. ,0. ,
171 6 -.932469514203152,-.661209386466265,-.238619186083197,
172 6 0.238619186083197,0.661209386466265,0.932469514203152,
173 6 0. ,0. ,0. ,
174 7 -.949107912342759,-.741531185599394,-.405845151377397,
175 7 0. ,0.405845151377397,0.741531185599394,
176 7 0.949107912342759,0. ,0. ,
177 8 -.960289856497536,-.796666477413627,-.525532409916329,
178 8 -.183434642495650,0.183434642495650,0.525532409916329,
179 8 0.796666477413627,0.960289856497536,0. ,
180 9 -.968160239507626,-.836031107326636,-.613371432700590,
181 9 -.324253423403809,0. ,0.324253423403809,
182 9 0.613371432700590,0.836031107326636,0.968160239507626/
183
184 my_real
185 . hh(2,mvsiz),c1,!GG(MVSIZ),
186 . m(9,mvsiz),
187 . lamda,nu,gg
188 my_real
189 . a11(mvsiz), a12(mvsiz), a13(mvsiz),
190 . a21(mvsiz), a22(mvsiz), a23(mvsiz),
191 . a31(mvsiz), a32(mvsiz), a33(mvsiz)
192
193C----HH(1,):lamda,HH(2,):G; HH1 :effective lamda,g for Icpre=1
194C-----------------------------------------------
195C S o u r c e L i n e s
196C-----------------------------------------------
197 gbuf => elbuf_str%GBUF
198 nlay = elbuf_str%NLAY
199 IF (mpt == 222) THEN
200 nptr = 2
201 npts = 2
202 nptt = 2
203 ELSE
204 nptr = elbuf_str%NPTR
205 npts = elbuf_str%NPTS
206 nptt = elbuf_str%NPTT
207 ENDIF
208 iad0 = 1
209 IF (isorth > 0) iad0 = 1 + 6*nel
210 IF (igtyp == 21.OR.igtyp == 22) THEN
211 ikorth=2
212 ELSEIF (isorth>0) THEN
213 ikorth=1
214 ELSE
215 ikorth=0
216 ENDIF
217C-----------
218 nf1=nft+1
219C-----------
220 CALL s8scoork_imp(x,ixs(1,nf1),
221 . x1, x2, x3, x4, x5, x6, x7, x8,
222 . y1, y2, y3, y4, y5, y6, y7, y8,
223 . z1, z2, z3, z4, z5, z6, z7, z8,
224 . gbuf%OFF,offg,gbuf%SMSTR, gbuf%COR_FR,
225! . R11, R12, R13, R21, R22, R23, R31, R32, R33,
226 . v1,v2,v3,v4,v5,v6,v7,v8,
227 . nc1,nc2,nc3,nc4,nc5,nc6,nc7,nc8,ngl,mxt,ngeo,
228 . k11,k12,k13,k14,k15,k16,k17,k18,k22,k23,
229 . k24,k25,k26,k27,k28,k33,k34,k35,k36,k37,
230 . k38,k44,k45,k46,k47,k48,k55,k56,k57,k58,
231 . k66,k67,k68,k77,k78,k88,jhbe,gbuf%GAMA,gama,
232 . nel,trm,kl) !,TRM
233C
234 pid=ngeo(1)
235C IGTYP=NINT(GEO(12,PID))
236C CALL GET_GAMA(MTN,NEL,NBGAMA,JCVT,PM,IXS(1,NF1),IGTYP)
237 DO i=1,nel
238 nu =pm(21,mxt(i))
239 c1 =three*pm(32,mxt(i))/(one+nu)
240 lamda=c1*nu
241 gg =c1*(one-two*nu)
242 hh(1,i)=lamda
243 hh(2,i)=gg*half
244 ENDDO
245 icpg = icp
246 IF (jhbe/=14.AND.jhbe/=17.AND.jhbe/=24) THEN
247 icpg = 1
248 ENDIF
249c
250
251C-----------Matrix B----------
252C-----------Begin integrating points-----
253 il = 1
254! DO IR=1,NPTR
255! DO IS=1,NPTS
256 DO is=1,npts
257 DO ir=1,nptr
258 DO it=1,nptt
259 IF (jhbe == 14.OR.jhbe == 12.OR.jhbe == 17) THEN
260 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
261 ELSE
262 lbuf => elbuf_str%BUFLY(il)%LBUF(1,1,1)
263 ENDIF
264C-----------
265 ip = ir + ( (is-1) + (it-1)*npts )*nptr
266 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*w_gauss(it,nptt)
267C
268! used for full integration
269! CALL S8SDERI3(OFFG,OFF,VOLN,NGL,
270! . A_GAUSS(IR,NPTR),A_GAUSS(IS,NPTS),A_GAUSS(IT,NPTT),WI,
271! . X1,X2,X3,X4,X5,X6,X7,X8,
272! . Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,
273! . Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8,
274! . DN_X,DN_Y,DN_Z,VOLM)
275! used for ANS formulation
276 CALL s8sderi3(
277 1 offg, off, voln, ngl,
278 2 a_gauss(it,nptt),a_gauss(ir,nptr),a_gauss(is,npts),wi,
279 3 x1, x2, x3, x4,
280 4 x5, x6, x7, x8,
281 5 y1, y2, y3, y4,
282 6 y5, y6, y7, y8,
283 7 z1, z2, z3, z4,
284 8 z5, z6, z7, z8,
285 9 a11, a12, a13, a21,
286 a a22, a23, a31, a32,
287 b a33, dn_r, dn_s, dn_t,
288 c invj, dn_x, dn_y, dn_z,
289 d volm, nel)
290 CALL s8slke3(
291 1 kl, hh, voln, !DN_X,
292 2 dn_y, dn_z, a_gauss(it,nptt),a_gauss(ir,nptr),
293 3 a_gauss(is,npts),dn_r, dn_s, dn_t,
294 4 invj, x1, x2, x3,
295 5 x4, x5, x6, x7,
296 6 x8, y1, y2, y3,
297 7 y4, y5, y6, y7,
298 8 y8, z1, z2, z3,
299 9 z4, z5, z6, z7,
300 a z8, a11, a12, a13,
301 b a21, a22, a23, a31,
302 c a32, a33, nel)
303 ENDDO
304 ENDDO
305 ENDDO
306
307 CALL transk(
308 1 kl, trm, nel)
309C-------------
310 CALL s8sksig(x,ixs(1,nf1),nel,
311 . gbuf%COR_NF,ks,v1,v2,v3,v4,v5,v6,v7,v8,
312 . nc1,nc2,nc3,nc4,nc5,nc6,nc7,nc8)
313 DO k=1,nel
314 DO j=1,24
315 DO i=1,24
316 kl(i,j,k)=kl(i,j,k)+ks(i,j,k)
317 ENDDO
318 ENDDO
319 ENDDO
320C----------------------------
321C CONVECTE --> GLOBAL.
322C----------------------------
323 IF (neig>0) CALL s8eoff(
324 1 1, nel, ixs(1,nf1), etag, offg)
325
326 DO k=1,nel
327 DO j=1,3
328 jj=3*(j-1)
329 DO i=1,3
330 ij= i+jj
331 k11(ij,k)=kl(i,j,k)
332 k22(ij,k)=kl(i+3,j+3,k)
333 k33(ij,k)=kl(i+6,j+6,k)
334 k44(ij,k)=kl(i+9,j+9,k)
335 k55(ij,k)=kl(i+12,j+12,k)
336 k66(ij,k)=kl(i+15,j+15,k)
337 k77(ij,k)=kl(i+18,j+18,k)
338 k88(ij,k)=kl(i+21,j+21,k)
339 k12(ij,k)=kl(i,j+3,k)
340 k13(ij,k)=kl(i,j+6,k)
341 k14(ij,k)=kl(i,j+9,k)
342 k15(ij,k)=kl(i,j+12,k)
343 k16(ij,k)=kl(i,j+15,k)
344 k17(ij,k)=kl(i,j+18,k)
345 k18(ij,k)=kl(i,j+21,k)
346 k23(ij,k)=kl(i+3,j+6,k)
347 k24(ij,k)=kl(i+3,j+9,k)
348 k25(ij,k)=kl(i+3,j+12,k)
349 k26(ij,k)=kl(i+3,j+15,k)
350 k27(ij,k)=kl(i+3,j+18,k)
351 k28(ij,k)=kl(i+3,j+21,k)
352 k34(ij,k)=kl(i+6,j+9,k)
353 k35(ij,k)=kl(i+6,j+12,k)
354 k36(ij,k)=kl(i+6,j+15,k)
355 k37(ij,k)=kl(i+6,j+18,k)
356 k38(ij,k)=kl(i+6,j+21,k)
357 k45(ij,k)=kl(i+9,j+12,k)
358 k46(ij,k)=kl(i+9,j+15,k)
359 k47(ij,k)=kl(i+9,j+18,k)
360 k48(ij,k)=kl(i+9,j+21,k)
361 k56(ij,k)=kl(i+12,j+15,k)
362 k57(ij,k)=kl(i+12,j+18,k)
363 k58(ij,k)=kl(i+12,j+21,k)
364 k67(ij,k)=kl(i+15,j+18,k)
365 k68(ij,k)=kl(i+15,j+21,k)
366 k78(ij,k)=kl(i+18,j+21,k)
367 ENDDO
368 ENDDO
369 ENDDO
370
371 CALL assem_s8(
372 1 ixs(1,nf1),nel ,iddl ,ndof ,k_diag,
373 2 k_lt ,iadk ,jdik ,k11 ,k12 ,
374 3 k13 ,k14 ,k15 ,k16 ,k17 ,
375 4 k18 ,k22 ,k23 ,k24 ,k25 ,
376 5 k26 ,k27 ,k28 ,k33 ,k34 ,
377 6 k35 ,k36 ,k37 ,k38 ,k44 ,
378 7 k45 ,k46 ,k47 ,k48 ,k55 ,
379 8 k56 ,k57 ,k58 ,k66 ,k67 ,
380 9 k68 ,k77 ,k78 ,k88 ,offg )
381C
382 RETURN
assem_s8
subroutine assem_s8(ixs, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, k11, k12, k13, k14, k15, k16, k17, k18, k22, k23, k24, k25, k26, k27, k28, k33, k34, k35, k36, k37, k38, k44, k45, k46, k47, k48, k55, k56, k57, k58, k66, k67, k68, k77, k78, k88, off)
Definition assem_s8.F:45
my_real
#define my_real
Definition cppsort.cpp:32
s8eoff
subroutine s8eoff(jft, jlt, ixs, etag, off)
Definition s8eoff.F:35
s8sderi3
subroutine s8sderi3(offg, off, voldp, ngl, ksi, eta, zeta, wi, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, a11, a12, a13, a21, a22, a23, a31, a32, a33, dn_r, dn_s, dn_t, invj, dn_x, dn_y, dn_z, voln, nel)
Definition s8sderi3.F:43
s8sksig
subroutine s8sksig(x, ixs, nel, qf, ks, v1, v2, v3, v4, v5, v6, v7, v8, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition s8sksig.F:32
s8slke3
subroutine s8slke3(kl, hh, vol, dn_y, dn_z, ksi, eta, zeta, dn_r, dn_s, dn_t, invj, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, a11, a12, a13, a21, a22, a23, a31, a32, a33, nel)
Definition s8slke3.F:44
s8scoork_imp
subroutine s8scoork_imp(x, ixs, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, offg, off, sav, r, v1, v2, v3, v4, v5, v6, v7, v8, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, ngl, mxt, ngeo, k11, k12, k13, k14, k15, k16, k17, k18, k22, k23, k24, k25, k26, k27, k28, k33, k34, k35, k36, k37, k38, k44, k45, k46, k47, k48, k55, k56, k57, k58, k66, k67, k68, k77, k78, k88, khbe, gama0, gama, nel, trm, kl)
Definition srcoork_imp.F:44
transk
subroutine transk(kl, trm, nel)
Definition transk.F:31