50
51
52
53 USE elbufdef_mod
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "com04_c.inc"
66#include "param_c.inc"
67
68
69
70 INTEGER, INTENT(IN) :: ISMSTR
71 INTEGER, INTENT(IN) :: NFT
72 INTEGER, INTENT(IN) :: MTN
73 INTEGER, INTENT(IN) :: JHBE
74 INTEGER, INTENT(IN) :: ISORTH
75 INTEGER, INTENT(INOUT) ::
76 INTEGER ICP, ICSIG,IKGEO,NEL ,NPG
77 INTEGER ETAG(*),IDDL(*) ,NDOF(*) ,IADK(*) ,JDIK(*),
78 . IXS(NIXS,*),IPM(NPROPMI,*),IGEO(NPROPGI,*)
79
81 . pm(npropm,*), geo(npropg,*), x(*),
82 . k11(9,mvsiz),k12(9,mvsiz),k13(9,mvsiz),k14(9,mvsiz),k15(9,mvsiz),
83 . k16(9,mvsiz),k22(9,mvsiz),k23(9,mvsiz),k24
84 . k26(9,mvsiz),k33(9,mvsiz),k34(9,mvsiz),k35(9,mvsiz),k36(9,mvsiz),
85 . k44(9,mvsiz),k45(9,mvsiz),k46(9,mvsiz),k55(9,mvsiz),k56(9,mvsiz),
86 . k66(9,mvsiz) ,offg(mvsiz) ,bufmat(*),k_diag(*) ,k_lt(*)
87 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
88
89
90
91 INTEGER LCO, NF1, IFLAG, NB3S, I,IS,IAD0
92 INTEGER IADBUF,IKORTH,IBID,IUN,IP,NLAY
93 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ),PID
95 . voln(mvsiz), deltax(mvsiz),
96 . aj1(mvsiz) , aj2(mvsiz) , aj3(mvsiz) ,
97 . aj4(mvsiz) , aj5(mvsiz) , aj6(mvsiz) ,
98 . aj7(mvsiz) , aj8(mvsiz) , aj9(mvsiz)
99
100 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
101 . NC5(MVSIZ), NC6(MVSIZ), NC7(MVSIZ), NC8(MVSIZ)
103 . off(mvsiz) ,bid(1),
104 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
105 . x5(mvsiz), x6(mvsiz),
106 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
107 . y5(mvsiz), y6(mvsiz),
108 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
109 . z5(mvsiz), z6(mvsiz),
110 . pxc1(mvsiz),pxc2(mvsiz),pxc3(mvsiz),pxc4(mvsiz),
111 . pyc1(mvsiz),pyc2(mvsiz),pyc3(mvsiz),pyc4(mvsiz),
112 . pzc1(mvsiz),pzc2(mvsiz),pzc3(mvsiz),pzc4(mvsiz),
113 . px1h(mvsiz),px2h(mvsiz),px3h(mvsiz),
114 . py1h(mvsiz),py2h(mvsiz),py3h(mvsiz),
115 . pz1h(mvsiz),pz2h(mvsiz),pz3h(mvsiz)
117 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
118 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
119 . r31(mvsiz),r32(mvsiz),r33(mvsiz),gama(mvsiz,6)
120
122 . volg(mvsiz),
123 . b1122(mvsiz),b1221(mvsiz),b2212(mvsiz),b1121(mvsiz),
124 . b1122h(mvsiz),b1221h(mvsiz),b2212h(mvsiz),b1121h(mvsiz),
125 . b1x(mvsiz,2),b1y(mvsiz,2),b2x(mvsiz,2),b2y(mvsiz,2),
126 . b1xh(mvsiz,2),b1yh(mvsiz,2),b2xh(mvsiz,2),b2yh(mvsiz,2),
127 . vzl(mvsiz),ji33(mvsiz)
128 TYPE(G_BUFEL_) ,POINTER :: GBUF
129 TYPE(L_BUFEL_) ,POINTER :: LBUF
131 . w_gauss(9,9),a_gauss(9,9)
132 DATA w_gauss /
133 1 2. ,0. ,0. ,
134 1 0. ,0. ,0. ,
135 1 0. ,0. ,0. ,
136 2 1. ,1. ,0. ,
137 2 0. ,0. ,0. ,
138 2 0. ,0. ,0. ,
139 3 0.555555555555556,0.888888888888889,0.555555555555556,
140 3 0. ,0. ,0. ,
141 3 0. ,0. ,0. ,
142 4 0.347854845137454,0.652145154862546,0.652145154862546,
143 4 0.347854845137454,0. ,0. ,
144 4 0. ,0. ,0. ,
145 5 0.236926885056189,0.478628670499366,0.568888888888889,
146 5 0.478628670499366,0.236926885056189,0. ,
147 5 0. ,0. ,0. ,
148 6 0.171324492379170,0.360761573048139,0.467913934572691,
149 6 0.467913934572691,0.360761573048139,0.171324492379170,
150 6 0. ,0. ,0. ,
151 7 0.129484966168870,0.279705391489277,0.381830050505119,
152 7 0.417959183673469,0.381830050505119,0.279705391489277,
153 7 0.129484966168870,0. ,0. ,
154 8 0.101228536290376,0.222381034453374,0.313706645877887,
155 8 0.362683783378362,0.362683783378362,0.313706645877887,
156 8 0.222381034453374,0.101228536290376,0. ,
157 9 0.081274388361574,0.180648160694857,0.260610696402935,
158 9 0.312347077040003,0.330239355001260,0.312347077040003,
159 9 0.260610696402935,0.180648160694857,0.081274388361574/
160 DATA a_gauss /
161 1 0. ,0. ,0. ,
162 1 0. ,0. ,0. ,
163 1 0. ,0. ,0. ,
164 2 -.577350269189626,0.577350269189626,0. ,
165 2 0. ,0. ,0. ,
166 2 0. ,0. ,0. ,
167 3 -.774596669241483,0. ,0.774596669241483,
168 3 0. ,0. ,0. ,
169 3 0. ,0. ,0. ,
170 4 -.861136311594053,-.339981043584856,0.339981043584856,
171 4 0.861136311594053,0. ,0. ,
172 4 0. ,0. ,0. ,
173 5 -.906179845938664,-.538469310105683,0. ,
174 5 0.538469310105683,0.906179845938664,0. ,
175 5 0. ,0. ,0. ,
176 6 -.932469514203152,-.661209386466265,-.238619186083197,
177 6 0.238619186083197,0.661209386466265,0.932469514203152,
178 6 0. ,0. ,0. ,
179 7 -.949107912342759,-.741531185599394,-.405845151377397,
180 7 0. ,0.405845151377397,0.741531185599394,
181 7 0.949107912342759,0. ,0. ,
182 8 -.960289856497536,-.796666477413627,-.525532409916329,
183 8 -.183434642495650,0.183434642495650,0.525532409916329,
184 8 0.796666477413627,0.960289856497536,0. ,
185 9 -.968160239507626,-.836031107326636,-.613371432700590,
186 9 -.324253423403809,0. ,0.324253423403809,
187 9 0.613371432700590,0.836031107326636,0.968160239507626/
188
190 . nu(mvsiz),nu1(mvsiz),hh(2,mvsiz),fac(mvsiz),c1,e0(mvsiz),
191 . dd(9,mvsiz),gg(mvsiz),dm(9,mvsiz),gm(9,mvsiz),dgm(9,mvsiz),
192 . dg(9,mvsiz),g33(9,mvsiz)
193
194
195
196
197 gbuf => elbuf_str%GBUF
198 nlay = elbuf_str%NLAY
199 iad0 = 1
200 IF (isorth > 0) iad0 = 1 + 6*nel
201 isorthg = 0
202 ikorth=0
203
204 nf1=nft+1
205
207 1 x, ixs(1,nf1),x1, x2,
208 2 x3, x4, x5, x6,
209 3 y1, y2, y3, y4,
210 4 y5, y6, z1, z2,
211 5 z3, z4, z5, z6,
212 6 gbuf%OFF, offg, gbuf%SMSTR,r11,
213 7 r12, r13, r21, r22,
214 8 r23, r31, r32, r33,
215 9 nc1, nc2, nc3, nc4,
216 a nc5, nc6, ngl, mxt,
217 b ngeo, k11, k12, k13,
218 c k14, k15, k16, k22,
219 d k23, k24, k25, k26,
220 e k33, k34, k35, k36,
221 f k44, k45, k46, k55,
222 g k56, k66, nel, ismstr)
223
224
225 DO i=1,nel
226 nu(i)=
min(half,pm(21,mxt(i)))
227 c1 =pm(32,mxt(i))
228 e0(i) =three*(one-two*nu(i))*c1
229 ENDDO
230
231 IF (icp==1) THEN
232 DO i=1,nel
233 nu1(i)=half
234 ENDDO
235 ELSEIF (icp==2) THEN
236 CALL s8zsigp3(1 ,nel ,gbuf%SIG,e0,gbuf%PLA,
237 2 fac ,gbuf%G_PLA,nel )
238 DO i=1,nel
239 nu1(i)=nu(i)+(half-nu(i))*fac(i)
240 ENDDO
241 ELSE
242 DO i=1,nel
243 nu1(i) =nu(i)
244 ENDDO
245 ENDIF
247 1 offg, voln, ngl, x1,
248 2 x2, x3, x4, x5,
249 3 x6, y1, y2, y3,
250 4 y4, y5, y6, z1,
251 5 z2, z3, z4, z5,
252 6 z6, pxc1, pxc2, pxc3,
253 7 pxc4, pyc1, pyc2, pyc3,
254 8 pyc4, pzc1, pzc2, pzc3,
255 9 pzc4, px1h, px2h, px3h,
256 a py1h, py2h, py3h, pz1h,
257 b pz2h, pz3h, aj1, aj2,
258 c aj3, aj4, aj5, aj6,
259 d ji33, b1x, b1y, b2y,
260 e b2x, b1122, b1221, b2212,
261 f b1121, b1xh, b1yh, b2xh,
262 g b2yh, b1122h, b1221h, b2212h,
263 h b1121h, vzl, volg, gbuf%SMSTR,
264 i gbuf%OFF, nel, ismstr)
265 IF (mtn>=28) THEN
266 iadbuf = ipm(7,mxt(1))
267 ELSE
268 iadbuf = 0
269 ENDIF
270
271 CALL mmats(1 ,nel ,pm ,mxt ,hh ,
272 . mtn ,ikorth ,ipm ,igeo ,gama ,
273 . bufmat(iadbuf) ,dm ,dgm ,gm ,
274 . jhbe ,gbuf%SIG ,bid ,nlay ,nel )
275
276 ibid=0
277 iun = 1
278 DO is=1,nlay
279 lbuf => elbuf_str%BUFLY(is)%LBUF(1,1,1)
280 DO i=1,nel
281 voln(i)=half*w_gauss(is,nlay)*(volg(i)+vzl(i)*a_gauss(is,nlay))
282 ENDDO
284 1 pm, mxt, hh, voln,
285 2 ibid, dd, gg, dg,
286 3 g33, dm, gm, dgm,
287 4 ikorth, lbuf%SIG,iun, iun,
288 5 is, nel, jhbe, mtn)
290 1 pxc1, pxc2, pxc3, pxc4,
291 2 pyc1, pyc2, pyc3, pyc4,
292 3 pzc1, pzc2, pzc3, pzc4,
293 4 px1h, px2h, px3h, py1h,
294 5 py2h, py3h, pz1h, pz2h,
295 6 pz3h, ji33, b1x, b1y,
296 7 b2y, b2x, b1122, b1221,
297 8 b2212, b1121, b1xh, b1yh,
298 9 b2xh, b2yh, b1122h, b1221h,
299 a b2212h, b1121h, dd, gg,
300 b voln, a_gauss(is,nlay),w_gauss(is,nlay),nu1,
301 c k11, k12, k13, k14,
302 d k15, k16, k22, k23,
303 e k24, k25, k26, k33,
304 f k34, k35, k36, k44,
305 g k45, k46, k55, k56,
306 h k66, nel)
307 ENDDO
308
309
310
311 IF (ikgeo>0) THEN
313 1 gbuf%SIG,volg, pxc1, pxc2,
314 2 pxc3, pxc4, pyc1, pyc2,
315 3 pyc3, pyc4, k11, k12,
316 4 k13, k14, k15, k16,
317 5 k22, k23, k24, k25,
318 6 k26, k33, k34, k35,
319 7 k36, k44, k45, k46,
320 8 k55, k56, k66, nel)
321 ENDIF
322
323
324
326 1 r11, r21, r31, r12,
327 2 r22, r32, r13, r23,
328 3 r33, k11, k12, k13,
329 4 k14, k15, k16, k22,
330 5 k23, k24, k25, k26,
331 6 k33, k34, k35, k36,
332 7 k44, k45, k46, k55,
333 8 k56, k66, x1, x2,
334 9 x3, x4, x5, x6,
335 a y1, y2, y3, y4,
336 b y5, y6, z1, z2,
337 c z3, z4, z5, z6,
338 d nel)
339
341 1 1, nel, ixs(1,nf1), etag, offg)
343 1 ixs(1,nf1),nel ,iddl ,ndof ,k_diag,
344 2 k_lt ,iadk ,jdik ,k11 ,k12 ,
345 3 k13 ,k14 ,k15 ,k16 ,k22 ,
346 4 k23 ,k24 ,k25 ,k26 ,k33 ,
347 5 k34 ,k35 ,k36 ,k44 ,k45 ,
348 6 k46 ,k55 ,k56 ,k66 ,offg )
349
350 RETURN
subroutine assem_s6(ixs, nel, iddl, ndof, k_diag, k_lt, iadk, jdik, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, off)
subroutine mmats(jft, jlt, pm, mat, hh, mtn, iorth, ipm, igeo, gama, uparam, cc, cg, g33, jhbe, sig, eps, nppt, nel)
subroutine mmstifs(pm, mat, hh, vol, icsig, dd, gg, dg, g33, dm, gm, dgm, iorth, sig, ir, is, it, nel, jhbe, mtn)
subroutine s6ccumg3(r11, r21, r31, r12, r22, r32, r13, r23, r33, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, nel)
subroutine s6ckgeo3(sig, vol, pxc1, pxc2, pxc3, pxc4, pyc1, pyc2, pyc3, pyc4, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, nel)
subroutine s6clke3(pxc1, pxc2, pxc3, pxc4, pyc1, pyc2, pyc3, pyc4, pzc1, pzc2, pzc3, pzc4, px1h, px2h, px3h, py1h, py2h, py3h, pz1h, pz2h, pz3h, ji33, b1x, b1y, b2y, b2x, b1122, b1221, b2212, b1121, b1xh, b1yh, b2xh, b2yh, b1122h, b1221h, b2212h, b1121h, dd, gg, vol, zi, wi, nu, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, nel)
subroutine s6rcoork(x, ixs, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, offg, off, sav, r11, r12, r13, r21, r22, r23, r31, r32, r33, nc1, nc2, nc3, nc4, nc5, nc6, ngl, mxt, ngeo, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, nel, ismstr)
subroutine s8eoff(jft, jlt, ixs, etag, off)
subroutine s8zsigp3(lft, llt, sig, e0, defp, fac, g_pla, nel)
subroutine s6cderi3(nel, vol, geo, vzl, ngl, deltax, det, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)