41
42
43
44 USE elbufdef_mod
47 use element_mod , only : nixc,nixtg
48
49
50
51#include "implicit_f.inc"
52#include "mvsiz_p.inc"
53
54
55
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "units_c.inc"
59#include "scr16_c.inc"
60
61
62
63
64 INTEGER IHBE,NEL,NPT,JJ,MLW,ITY,,IW,NLAY,
65 . NPTR,NPTS,ITHK,NFT,NPG,IGTYP,IGEO(NPROPGI,*),
66 . IXFEM,ISUBSTACK,IXC(NIXC,*),
67 . IXTG(NIXTG,*),MPT
69 . wa(*),thke(*),geo(npropg,*)
70
71 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
72 TYPE (STACK_PLY) :: STACK
73 TYPE(DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
74 TYPE(DRAPEG_) :: DRAPEG
75
76
77
78 INTEGER I,J,,IPT,II(12),
79 . PTF,PTM,PTS,NG,IR,IS,LENF,LENM,
80 . LENS,MAT_1,PID_1,LAYNPT_MAX,NLAY_MAX,IXLAY,IPT_ALL,
81 . IT,NPTT,ILAY,SHIFT,SEDRAPE,NUMEL_DRAPE
82 INTEGER (MVSIZ),PID(MVSIZ)
84 . func(6),qpg(2,4),pg,mpg,
85 . sig0(6,mvsiz),eps(mvsiz),mom0(3,mvsiz),
86 . sk(2,mvsiz),st(2,mvsiz),mk(2,mvsiz),mt(2,mvsiz),
87 . shk(2,mvsiz),sht(2,mvsiz),z01(11,11),zz
88
89 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY
90 my_real,
DIMENSION(:) ,
ALLOCATABLE :: thkly
91 my_real,
DIMENSION(:,:) ,
ALLOCATABLE :: posly,thk_ly
92 parameter(pg = .577350269189626)
93 parameter(mpg=-.577350269189626)
94 DATA qpg/mpg,mpg,pg,mpg,pg,pg,mpg,pg/
95 DATA z01/
96 1 0. ,0. ,0. ,0. ,0. ,
97 1 0. ,0. ,0. ,0. ,0. ,0. ,
98 2 -.5 ,0.5 ,0. ,0. ,0. ,
99 2 0. ,0. ,0. ,0. ,0. ,0. ,
100 3 -.5 ,0. ,0.5 ,0. ,0. ,
101 3 0. ,0. ,0. ,0. ,0. ,0. ,
102 4 -.5 ,-.1666667,0.1666667,0.5 ,0. ,
103 4 0. ,0. ,0. ,0. ,0. ,0. ,
104 5 -.5 ,-.25 ,0. ,0.25 ,0.5 ,
105 5 0. ,0. ,0. ,0. ,0. ,0. ,
106 6 -.5 ,-.3 ,-.1 ,0.1 ,0.3 ,
107 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
108 7 -.5 ,-.3333333,-.1666667,0.0 ,0.1666667,
109 7 0.3333333,0.5 ,0. ,0. ,0. ,0. ,
110 8 -.5 ,-.3571429,-.2142857,-.0714286,0.0714286,
111 8 0.2142857,0.3571429,0.5 ,0. ,0. ,0. ,
112 9 -.5 ,-.375 ,-.25 ,-.125 ,0.0 ,
113 9 0.125 ,0.25 ,0.375 ,0.5 ,0. ,0. ,
114 a -.5 ,-.3888889,-.2777778,-.1666667,0.0555555,
115 a 0.0555555,0.1666667,0.2777778,0.3888889,0.5 ,0. ,
116 b -.5 ,-.4 ,-.3 ,-.2 ,-.1 ,
117 b 0. ,0.1 ,0.2 ,0.3 ,0.4 ,0.5 /
118
119 TYPE(BUF_LAY_) ,POINTER :: BUFLY
120 TYPE(G_BUFEL_) ,POINTER :: GBUF
121 TYPE(L_BUFEL_) ,POINTER :: LBUF
122
123 gbuf => elbuf_str%GBUF
124
125 DO i=1,12
126 ii(i) = nel*(i-1)
127 ENDDO
128
129
130 laynpt_max = 1
131 IF(igtyp == 51 .OR. igtyp == 52) THEN
132 DO ilay=1,nlay
133 laynpt_max =
max(laynpt_max , elbuf_str%BUFLY(ilay)%NPTT)
134 ENDDO
135 ENDIF
136 nlay_max =
max(nlay,npt, elbuf_str%NLAY)
137 ALLOCATE(matly(mvsiz*nlay_max), thkly(mvsiz*nlay_max*laynpt_max),
138 . posly(mvsiz,nlay_max*laynpt_max),thk_ly(nel,nlay_max*laynpt_max))
139 matly = 0
140 thkly = zero
141 posly = zero
142 thk_ly = zero
143
144 shift = 1+nft
145 IF (ity == 7) shift = shift + numelc
146
147 IF (ity == 3) THEN
148 mat_1 = ixc(1,1+nft)
149 pid_1 = ixc(6,1+nft)
150 ELSEIF (ity == 7) THEN
151 mat_1 = ixtg(1,1+nft)
152 pid_1 = ixtg(5,1+nft)
153 ENDIF
154 DO i=1,nel
155 mat(i)= mat_1
156 pid(i)= pid_1
157 ENDDO
158
159 ixlay = 0
160
161 IF(ity == 7) THEN
165 . elbuf_str,1 ,nel ,geo ,igeo ,
166 . mat ,pid ,thkly ,matly ,posly ,
167 . igtyp ,ixfem,ixlay ,nlay ,npt ,
168 . isubstack,stack,drape_sh3n ,nft ,thke ,
169 . nel ,thk_ly ,drapeg%INDX_SH3N ,sedrape,numel_drape )
170 ELSE
174 . elbuf_str,1 ,nel ,geo ,igeo ,
175 . mat ,pid ,thkly ,matly ,posly ,
176 . igtyp ,ixfem,ixlay ,nlay ,npt ,
177 . isubstack,stack,drape_sh4n ,nft ,thke ,
178 . nel ,thk_ly ,drapeg%INDX_SH4N,sedrape,numel_drape )
179 ENDIF
180
181
182
183 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
184
185 IF (ihbe == 23) THEN
186 npg = 4
187 DO i=1,nel
188 st(1,i)= gbuf%HOURG(ii(1)+i)
189 st(2,i)= -gbuf%HOURG(ii(2)+i)
190 mt(1,i)= gbuf%HOURG(ii(3)+i)
191 mt(2,i)= -gbuf%HOURG(ii(4)+i)
192 sk(1,i)= -gbuf%HOURG(ii(7)+i)
193 sk(2,i)= gbuf%HOURG(ii(8)+i)
194 mk(1,i)= -gbuf%HOURG(ii(9)+i)
195 mk(2,i)= gbuf%HOURG(ii(10)+i)
196 sht(1,i)= gbuf%HOURG(ii(5)+i)
197 sht(2,i)= -gbuf%HOURG(ii(6)+i)
198 shk(1,i)= -gbuf%HOURG(ii(11)+i)
199 shk(2,i)= gbuf%HOURG(ii(12)+i)
200 ENDDO
201 ENDIF
202
203 IF (iw == 0) THEN
204
205
206
207 IF (ihbe == 23) THEN
208 IF (mpt == 0) THEN
209 DO i=1,nel
210 sig0(1,i) = gbuf%FOR(ii(1)+i)
211 sig0(2,i) = gbuf%FOR(ii(2)+i)
212 sig0(3,i) = gbuf%FOR(ii(3)+i)
213 sig0(4,i) = gbuf%FOR(ii(4)+i)
214 sig0(5,i) = gbuf%FOR(ii(5)+i)
215 IF (gbuf%G_PLA > 0) THEN
216 eps(i) = gbuf%PLA(i)
217 ELSE
218 eps(i) = zero
219 ENDIF
220 mom0(1,i) = gbuf%MOM(ii(1)+i)
221 mom0(2,i) = gbuf%MOM(ii(2)+i)
222 mom0(3,i) = gbuf%MOM(ii(3)+i)
223 ENDDO
224
225 DO i=1,nel
226 IF (outyy_fmt == 2) THEN
227 IF (ithk > 0) THEN
228 WRITE(iugeo,'(2I8/,1P3E12.5)')
229 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
230 ELSE
231 WRITE(iugeo,'(2I8/,1P3E12.5)')
232 . mpt,npg,thke(i+nft),gbuf%EINT(i),gbuf%EINT(i+nel)
233 ENDIF
234 ELSE
235 IF (ithk > 0) THEN
236 WRITE(iugeo,'(2I10/,1P3E20.13)')
237 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
238 ELSE
239 WRITE(iugeo,'(2I10/,1P3E20.13)')
240 . mpt,npg,thke(i+nft),gbuf%EINT(i),gbuf%EINT(i+nel)
241 ENDIF
242 ENDIF
243 DO k=1,npg
244 func(1)=sig0(1,i)+st(1,i)*qpg(2,k)+sk(1,i)*qpg(1,k)
245 func(2)=sig0(2,i)+st(2,i)*qpg(2,k)+sk(2,i)*qpg(1,k)
246 func(3)=sig0(3,i)
247 func(4)=sig0(4,i)+sht(2,i)*qpg(2,k)+shk(2,i)*qpg(1,k)
248 func(5)=sig0(5,i)+sht(1,i)*qpg(2,k)+shk(1,i)*qpg(1,k)
249 func(6)=eps(i)
250 IF (outyy_fmt == 2) THEN
251 WRITE(iugeo,'(1P6E12.5)')(func(j),j=1,6)
252 ELSE
253 WRITE(iugeo,'(1P6E20.13)')(func(j),j=1,6)
254 ENDIF
255 func(1)=mom0(1,i)+mt(1,i)*qpg(2,k)+mk(1,i)*qpg(1,k)
256 func(2)=mom0(2,i)+mt(2,i)*qpg(2,k)+mk(2,i)*qpg(1,k)
257 func(3)=mom0(3,i)
258 IF (outyy_fmt == 2) THEN
259 WRITE(iugeo,'(1P3E12.5)')(func(j),j=1,3)
260 ELSE
261 WRITE(iugeo,'(1P3E20.13)')(func(j),j=1,3)
262 ENDIF
263 ENDDO
264 ENDDO
265
266 ELSE
267
268 DO i=1,nel
269
270 IF (outyy_fmt == 2) THEN
271 IF (ithk > 0) THEN
272 WRITE(iugeo,'(2I8/,1P3E12.5)')
273 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
274 ELSE
275 WRITE(iugeo,'(2I8/,1P3E12.5)')
276 . mpt,npg,thke(i+nft),gbuf%EINT(i),gbuf%EINT(i+nel)
277 ENDIF
278 ELSE
279 IF (ithk > 0) THEN
280 WRITE(iugeo,'(2I10/,1P3E20.13)')
281 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
282 ELSE
283 WRITE(iugeo,'(2I10/,1P3E20.13)')
284 . mpt,npg,thke(i+nft),gbuf%EINT(i),gbuf%EINT(i+nel)
285 ENDIF
286 ENDIF
287
288 IF (nlay == 1) THEN
289 bufly => elbuf_str%BUFLY(1)
290 nptt = bufly%NPTT
291 DO it = 1,nptt
292 lbuf => bufly%LBUF(1,1,it)
293 zz = gbuf%THK(i)*z01(it,nptt)
294 sig0(1,i) = lbuf%SIG(ii(1)+i)
295 sig0(2,i) = lbuf%SIG(ii(2)+i)
296 sig0(3,i) = lbuf%SIG(ii(3)+i)
297 sig0(4,i) = lbuf%SIG(ii(4)+i)
298 sig0(5,i) = lbuf%SIG(ii(5)+i)
299 DO k=1,npg
300 func(1)=sig0(1,i)+(st(1,i)+zz*mt(1,i))*qpg(2,k)+
301 . (sk(1,i)+zz*mk(1,i))*qpg(1,k)
302 func(2)=sig0(2,i)+(st(2,i)+zz*mt(2,i))*qpg(2,k)+
303 . (sk(2,i)+zz*mk(2,i))*qpg(1,k)
304 func(3)=sig0(3,i)
305 func(4)=sig0(4,i)+sht(2,i)*qpg(2,k)+shk(2,i)*qpg(1,k)
306 func(5)=sig0(5,i)+sht(1,i)*qpg(2,k)+shk(1,i)*qpg(1,k)
307 IF (bufly%L_PLA > 0) THEN
308 func(6)=lbuf%PLA(i)
309 ELSE
310 func(6)=zero
311 ENDIF
312 IF (outyy_fmt == 2) THEN
313 WRITE(iugeo,'(1P6E12.5)')(func(j),j=1,6)
314 ELSE
315 WRITE(iugeo,'(1P6E20.13)')(func(j),j=1,6)
316 ENDIF
317 ENDDO
318 ENDDO
319 ELSEIF (nlay > 1) THEN
320 ipt_all = 0
321 DO ilay = 1,nlay
322 bufly => elbuf_str%BUFLY(ilay)
323 nptt = bufly%NPTT
324 DO it=1,nptt
325 ipt = ipt_all + it
326 zz = gbuf%THK(i)*posly(i,ipt)
327 lbuf => bufly%LBUF(1,1,it)
328 sig0(1,i) = lbuf%SIG(ii(1)+i)
329 sig0(2,i) = lbuf%SIG(ii(2)+i)
330 sig0(3,i) = lbuf%SIG(ii(3)+i)
331 sig0(4,i) = lbuf%SIG(ii(4)+i)
332 sig0(5,i) = lbuf%SIG(ii(5)+i)
333 DO k=1,npg
334 func(1)=sig0(1,i)+(st(1,i)+zz*mt(1,i))*qpg(2,k)+
335 . (sk(1,i)+zz*mk(1,i))*qpg(1,k)
336 func(2)=sig0(2,i)+(st(2,i)+zz*mt(2,i))*qpg(2,k)+
337 . (sk(2,i)+zz*mk(2,i))*qpg(1,k)
338 func(3)=sig0(3,i)
339 func(4)=sig0(4,i)+sht(2,i)*qpg(2,k)+shk(2,i)*qpg(1,k)
340 func(5)=sig0(5,i)+sht(1,i)*qpg(2,k)+shk(1,i)*qpg(1,k)
341
342 IF (bufly%L_PLA > 0) THEN
343 func(6)=lbuf%PLA(i)
344 ELSE
345 func(6)=zero
346 ENDIF
347 IF (outyy_fmt == 2) THEN
348 WRITE(iugeo,'(1P6E12.5)')(func(j),j=1,6)
349 ELSE
350 WRITE(iugeo,'(1P6E20.13)')(func(j),j=1,6)
351 ENDIF
352 ENDDO
353 ENDDO
354 ipt_all = ipt_all + nptt
355 ENDDO
356 ENDIF
357 ENDDO
358 ENDIF
359
360 ELSEIF (ihbe == 11) THEN
361
362 lenf = nel*gbuf%G_FORPG/npg
363 lenm = nel*gbuf%G_MOMPG/npg
364 lens = nel*gbuf%G_STRPG/npg
365 IF (mpt == 0) THEN
366 DO i=1,nel
367 IF (outyy_fmt == 2) THEN
368 IF (ithk > 0) THEN
369 WRITE(iugeo,'(2I8/,1P3E12.5)')
370 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
371 ELSE
372 WRITE(iugeo,'(2I8/,1P3E12.5)')
373 . mpt,npg,thke(i+nft),gbuf%EINT(i),gbuf%EINT(i+nel)
374 ENDIF
375 ELSE
376 IF (ithk > 0) THEN
377 WRITE(iugeo,'(2I10/,1P3E20.13)')
378 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
379 ELSE
380 WRITE(iugeo,'(2I10/,1P3E20.13)')
381 . mpt,npg,thke(i+nft),gbuf%EINT(i),gbuf%EINT(i+nel)
382 ENDIF
383 ENDIF
384
385 bufly => elbuf_str%BUFLY(1)
386 DO is=1,npts
387 DO ir=1,nptr
388 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,1)
389 ng = nptr*(is-1) + ir
390 ptf = (ng-1)*lenf
391 ptm = (ng-1)*lenm
392 func(1) = gbuf%FORPG(ptf+ii(1)+i)
393 func(2) = gbuf%FORPG(ptf+ii(2)+i)
394 func(3) = gbuf%FORPG(ptf+ii(3)+i)
395 func(4) = gbuf%FORPG(ptf+ii(4)+i)
396 func(5) = gbuf%FORPG(ptf+ii(5)+i)
397 IF (bufly%L_PLA > 0) THEN
398 func(6) = lbuf%PLA(i)
399 ELSE
400 func(6) = zero
401 ENDIF
402 IF (outyy_fmt == 2) THEN
403 WRITE(iugeo,'(1P6E12.5)')(func(j),j=1,6)
404 ELSE
405 WRITE(iugeo,'(1P6E20.13)')(func(j),j=1,6)
406 ENDIF
407 func(1) = gbuf%MOMPG(ptm+ii(1)+i)
408 func(2) = gbuf%MOMPG(ptm+ii(2)+i)
409 func(3) = gbuf%MOMPG(ptm+ii(3)+i)
410 IF (outyy_fmt == 2) THEN
411 WRITE(iugeo,'(1P3E12.5)')(func(j),j=1,3)
412 ELSE
413 WRITE(iugeo,'(1P3E20.13)')(func(j),j=1,3)
414 ENDIF
415 ENDDO
416 ENDDO
417 ENDDO
418
419 ELSE
420 DO i=1,nel
421
422 IF (outyy_fmt == 2) THEN
423 IF (ithk > 0) THEN
424 WRITE(iugeo,'(2I8/,1P3E12.5)')
425 . mpt,npg,gbuf%THK(i),gbuf%EINT(i),gbuf%EINT(i+nel)
426 ELSE
427 WRITE(iugeo,'(2i8/,1p3e12.5)')
428 . MPT,NPG,THKE(I+NFT),GBUF%EINT(I),GBUF%EINT(I+NEL)
429 ENDIF
430 ELSE
431 IF (ITHK > 0) THEN
432 WRITE(IUGEO,'(2i10/,1p3e20.13)')
433 . MPT,NPG,GBUF%THK(I),GBUF%EINT(I),GBUF%EINT(I+NEL)
434 ELSE
435 WRITE(IUGEO,'(2i10/,1p3e20.13)')
436 . MPT,NPG,THKE(I+NFT),GBUF%EINT(I),GBUF%EINT(I+NEL)
437 ENDIF
438 ENDIF
439
440 IF (NLAY == 1) THEN
441 BUFLY => ELBUF_STR%BUFLY(1)
442 NPTT = BUFLY%NPTT ! MPT = NPTT
443 DO IT = 1,NPTT
444 DO IS = 1,NPTS
445 DO IR = 1,NPTR
446 LBUF => BUFLY%LBUF(IR,IS,IT)
447 FUNC(1) = LBUF%SIG(II(1)+I)
448 FUNC(2) = LBUF%SIG(II(2)+I)
449 FUNC(3) = LBUF%SIG(II(3)+I)
450 FUNC(4) = LBUF%SIG(II(4)+I)
451 FUNC(5) = LBUF%SIG(II(5)+I)
452 IF (BUFLY%L_PLA > 0) THEN
453 FUNC(6)=LBUF%PLA(I)
454 ELSE
455 FUNC(6)=ZERO
456 ENDIF
457 IF (OUTYY_FMT == 2) THEN
458 WRITE(IUGEO,'(1p6e12.5)')(FUNC(J),J=1,6)
459 ELSE
460 WRITE(IUGEO,'(1p6e20.13)')(FUNC(J),J=1,6)
461 ENDIF
462 ENDDO ! DO IR = 1,NPTR
463 ENDDO ! DO IS = 1,NPTS
464 ENDDO ! IT = 1,NPTT
465 ELSEIF (NLAY > 1) THEN
466 DO ILAY=1,NLAY
467 BUFLY => ELBUF_STR%BUFLY(ILAY)
468 NPTT = BUFLY%NPTT
469 DO IT = 1,NPTT
470 DO IS = 1,NPTS
471 DO IR = 1,NPTR
472 LBUF => ELBUF_STR%BUFLY(ILAY)%LBUF(IR,IS,IT)
473 FUNC(1) = LBUF%SIG(II(1)+I)
474 FUNC(2) = LBUF%SIG(II(2)+I)
475 FUNC(3) = LBUF%SIG(II(3)+I)
476 FUNC(4) = LBUF%SIG(II(4)+I)
477 FUNC(5) = LBUF%SIG(II(5)+I)
478 IF (BUFLY%L_PLA > 0) THEN
479 FUNC(6) = LBUF%PLA(I)
480 ELSE
481 FUNC(6)=ZERO
482 ENDIF
483 IF (OUTYY_FMT == 2) THEN
484 WRITE(IUGEO,'(1p6e12.5)')(FUNC(J),J=1,6)
485 ELSE
486 WRITE(IUGEO,'(1p6e20.13)')(FUNC(J),J=1,6)
487 ENDIF
488 ENDDO ! DO IR = 1,NPTR
489 ENDDO ! DO IS = 1,NPTS
490 ENDDO ! DO IT = 1,NPTT
491 ENDDO ! DO ILAY=1,NLAY
492 ENDIF ! IF (NLAY == 1)
493
494 ENDDO ! DO I=1,NEL
495 ENDIF ! IF (MPT == 0)
496 ELSE ! IF (IHBE == 23)
497
498 ENDIF
499
500
501
502 ELSE ! IF (IW == 1)
503
504 IF (IHBE == 23) THEN
505
506 IF (MPT == 0) THEN
507 DO I=1,NEL
508 SIG0(1,I) = GBUF%FOR(II(1)+I)
509 SIG0(2,I) = GBUF%FOR(II(2)+I)
510 SIG0(3,I) = GBUF%FOR(II(3)+I)
511 SIG0(4,I) = GBUF%FOR(II(4)+I)
512 SIG0(5,I) = GBUF%FOR(II(5)+I)
513 IF (GBUF%G_PLA > 0) THEN
514 EPS(I) = GBUF%PLA(I)
515 ELSE
516 EPS(I) = ZERO
517 ENDIF
518 MOM0(1,I) = GBUF%MOM(II(1)+I)
519 MOM0(2,I) = GBUF%MOM(II(2)+I)
520 MOM0(3,I) = GBUF%MOM(II(3)+I)
521 ENDDO
522
523 DO I=1,NEL
524 WA(JJ+1) = IHBE
525 JJ=JJ+1
526 WA(JJ+1) = MPT
527 WA(JJ+2) = NPG
528 IF (ITHK > 0) THEN
529 WA(JJ+3) = GBUF%THK(I)
530 ELSE
531 WA(JJ+3) = THKE(I+NFT)
532 ENDIF
533 WA(JJ+4) = GBUF%EINT(I)
534 WA(JJ+5) = GBUF%EINT(I+NEL)
535 JJ = JJ + 5
536 DO K=1,NPG
537 WA(JJ+1)=SIG0(1,I)+ST(1,I)*QPG(2,K)+SK(1,I)*QPG(1,K)
538 WA(JJ+2)=SIG0(2,I)+ST(2,I)*QPG(2,K)+SK(2,I)*QPG(1,K)
539 WA(JJ+3)=SIG0(3,I)
540 WA(JJ+4)=SIG0(4,I)+SHT(2,I)*QPG(2,K)+SHK(2,I)*QPG(1,K)
541 WA(JJ+5)=SIG0(5,I)+SHT(1,I)*QPG(2,K)+SHK(1,I)*QPG(1,K)
542 WA(JJ+6)=EPS(I)
543 WA(JJ+7)=MOM0(1,I)+MT(1,I)*QPG(2,K)+MK(1,I)*QPG(1,K)
544 WA(JJ+8)=MOM0(2,I)+MT(2,I)*QPG(2,K)+MK(2,I)*QPG(1,K)
545 WA(JJ+9)=MOM0(3,I)
546 JJ = JJ + 9
547 ENDDO
548 ENDDO
549 ELSE ! IF (MPT /= 0)
550 DO I=1,NEL
551!! I5 = (I-1) * 2
552 WA(JJ+1) = IHBE
553 JJ=JJ+1
554 WA(JJ+1) = MPT
555 WA(JJ+2) = NPG
556 IF (ITHK > 0) THEN
557 WA(JJ+3) = GBUF%THK(I)
558 ELSE
559 WA(JJ+3) = THKE(I+NFT)
560 ENDIF
561 WA(JJ+4) = GBUF%EINT(I)
562 WA(JJ+5) = GBUF%EINT(I+NEL)
563 JJ = JJ + 5
564
565 IF (NLAY == 1) THEN
566 BUFLY => ELBUF_STR%BUFLY(1)
567 NPTT = BUFLY%NPTT ! MPT = NPTT
568 DO IT=1,NPTT
569 LBUF => BUFLY%LBUF(1,1,IT)
570 ZZ = GBUF%THK(I)*Z01(IT,NPTT)
571 SIG0(1,I) = LBUF%SIG(II(1)+I)
572 SIG0(2,I) = LBUF%SIG(II(2)+I)
573 SIG0(3,I) = LBUF%SIG(II(3)+I)
574 SIG0(4,I) = LBUF%SIG(II(4)+I)
575 SIG0(5,I) = LBUF%SIG(II(5)+I)
576
577 DO K=1,NPG
578 WA(JJ+1)=SIG0(1,I)+(ST(1,I)+ZZ*MT(1,I))*QPG(2,K)+
579 . (SK(1,I)+ZZ*MK(1,I))*QPG(1,K)
580 WA(JJ+2)=SIG0(2,I)+(ST(2,I)+ZZ*MT(2,I))*QPG(2,K)+
581 . (SK(2,I)+ZZ*MK(2,I))*QPG(1,K)
582 WA(JJ+3)=SIG0(3,I)
583 WA(JJ+4)=SIG0(4,I)+SHT(2,I)*QPG(2,K)+SHK(2,I)*QPG(1,K)
584 WA(JJ+5)=SIG0(5,I)+SHT(1,I)*QPG(2,K)+SHK(1,I)*QPG(1,K)
585
586 IF (BUFLY%L_PLA > 0) THEN
587 WA(JJ+6)=LBUF%PLA(I)
588 ELSE
589 WA(JJ+6)=ZERO
590 ENDIF
591 JJ = JJ + 6
592 ENDDO ! DO K=1,NPG
593 ENDDO ! DO IT=1,NPTT
594 ELSEIF (NLAY > 1) THEN
595 IPT_ALL = 0
596 DO ILAY=1,NLAY
597 BUFLY => ELBUF_STR%BUFLY(ILAY)
598 NPTT = BUFLY%NPTT
599 DO IT=1,NPTT
600 IPT = IPT_ALL + IT ! count all NPTT through all layers
601 ZZ = GBUF%THK(I)*POSLY(I,IPT)
602 LBUF => BUFLY%LBUF(1,1,IT)
603 SIG0(1,I) = LBUF%SIG(II(1)+I)
604 SIG0(2,I) = LBUF%SIG(II(2)+I)
605 SIG0(3,I) = LBUF%SIG(II(3)+I)
606 SIG0(4,I) = LBUF%SIG(II(4)+I)
607 SIG0(5,I) = LBUF%SIG(II(5)+I)
608 DO K=1,NPG
609 WA(JJ+1)=SIG0(1,I)+(ST(1,I)+ZZ*MT(1,I))*QPG(2,K)+
610 . (SK(1,I)+ZZ*MK(1,I))*QPG(1,K)
611 WA(JJ+2)=SIG0(2,I)+(ST(2,I)+ZZ*MT(2,I))*QPG(2,K)+
612 . (SK(2,I)+ZZ*MK(2,I))*QPG(1,K)
613 WA(JJ+3)=SIG0(3,I)
614 WA(JJ+4)=SIG0(4,I)+SHT(2,I)*QPG(2,K)+SHK(2,I)*QPG(1,K)
615 WA(JJ+5)=SIG0(5,I)+SHT(1,I)*QPG(2,K)+SHK(1,I)*QPG(1,K)
616
617 IF (BUFLY%L_PLA > 0) THEN
618 WA(JJ+6)=LBUF%PLA(I)
619 ELSE
620 WA(JJ+6)=ZERO
621 ENDIF
622 JJ = JJ + 6
623 ENDDO ! DO K=1,NPG
624 ENDDO ! DO IT=1,NPTT
625 IPT_ALL = IPT_ALL + NPTT
626 ENDDO ! DO ILAY=1,NLAY
627 ENDIF ! IF (NLAY == 1)
628 ENDDO ! DO I=1,NEL
629 ENDIF ! IF (MPT == 0)
630 ELSEIF (IHBE == 11) THEN
631
632 LENF = NEL*GBUF%G_FORPG/NPG
633 LENM = NEL*GBUF%G_MOMPG/NPG
634 LENS = NEL*GBUF%G_STRPG/NPG
635 IF (MPT == 0) THEN
636 DO I=1,NEL
637 WA(JJ+1) = IHBE
638 JJ=JJ+1
639 WA(JJ+1) = MPT
640 WA(JJ+2) = NPG
641 IF (ITHK > 0) THEN
642 WA(JJ+3) = GBUF%THK(I)
643 ELSE
644 WA(JJ+3) = THKE(I+NFT)
645 ENDIF
646 WA(JJ+4) = GBUF%EINT(I)
647 WA(JJ+5) = GBUF%EINT(I+NEL)
648 JJ = JJ + 5
649
650 DO IR=1,NPTR
651 DO IS=1,NPTS
652 NG = NPTR*(IS-1) + IR
653 PTF = (NG-1)*LENF
654 PTM = (NG-1)*LENM
655 PTS = (NG-1)*LENS
656!! I3 = PTS + I
657 WA(JJ+1) = GBUF%FORPG(PTF+II(1)+I)
658 WA(JJ+2) = GBUF%FORPG(PTF+II(2)+I)
659 WA(JJ+3) = GBUF%FORPG(PTF+II(3)+I)
660 WA(JJ+4) = GBUF%FORPG(PTF+II(4)+I)
661 WA(JJ+5) = GBUF%FORPG(PTF+II(5)+I)
662 WA(JJ+6) = GBUF%STRPG(PTS+II(1)+I)
663 WA(JJ+7) = GBUF%MOMPG(PTM+II(1)+I)
664 WA(JJ+8) = GBUF%MOMPG(PTM+II(2)+I)
665 WA(JJ+9) = GBUF%MOMPG(PTM+II(3)+I)
666 JJ = JJ + 9
667 ENDDO
668 ENDDO
669 ENDDO ! DO I=1,NEL
670
671 ELSE ! IF (MPT /= 0)
672 DO I=1,NEL
673 WA(JJ+1) = IHBE
674 JJ=JJ+1
675 WA(JJ+1) = MPT
676 WA(JJ+2) = NPG
677 IF (ITHK > 0) THEN
678 WA(JJ+3) = GBUF%THK(I)
679 ELSE
680 WA(JJ+3) = THKE(I+NFT)
681 ENDIF
682 WA(JJ+4) = GBUF%EINT(I)
683 WA(JJ+5) = GBUF%EINT(I+NEL)
684 JJ = JJ + 5
685
686 IF (NLAY == 1) THEN
687 BUFLY => ELBUF_STR%BUFLY(1)
688 NPTT = BUFLY%NPTT ! MPT = NPTT
689 DO IT = 1,NPTT
690 DO IS = 1,NPTS
691 DO IR = 1,NPTR
692 LBUF => BUFLY%LBUF(IR,IS,IT)
693 WA(JJ+1) = LBUF%SIG(II(1)+I)
694 WA(JJ+2) = LBUF%SIG(II(2)+I)
695 WA(JJ+3) = LBUF%SIG(II(3)+I)
696 WA(JJ+4) = LBUF%SIG(II(4)+I)
697 WA(JJ+5) = LBUF%SIG(II(5)+I)
698 IF (BUFLY%L_PLA > 0) THEN
699 WA(JJ+6) = LBUF%PLA(I)
700 ELSE
701 WA(JJ+6)=ZERO
702 ENDIF
703 JJ = JJ + 6
704 ENDDO ! DO IR = 1,NPTR
705 ENDDO ! DO IR = 1,NPTR
706 ENDDO !IT = 1,NPTT
707 ELSEIF (NLAY > 1) THEN
708 DO ILAY=1,NLAY
709 BUFLY => ELBUF_STR%BUFLY(ILAY)
710 NPTT = BUFLY%NPTT
711 DO IT = 1,NPTT
712 DO IS = 1,NPTS
713 DO IR = 1,NPTR
714 LBUF => ELBUF_STR%BUFLY(ILAY)%LBUF(IR,IS,IT)
715 WA(JJ+1) = LBUF%SIG(II(1)+I)
716 WA(JJ+2) = LBUF%SIG(II(2)+I)
717 WA(JJ+3) = LBUF%SIG(II(3)+I)
718 WA(JJ+4) = LBUF%SIG(II(4)+I)
719 WA(JJ+5) = LBUF%SIG(II(5)+I)
720 IF (BUFLY%L_PLA > 0) THEN
721 WA(JJ+6) = LBUF%PLA(I)
722 ELSE
723 WA(JJ+6)=ZERO
724 ENDIF
725 JJ = JJ + 6
726 ENDDO ! DO IR = 1,NPTR
727 ENDDO ! DO IS = 1,NPTS
728 ENDDO ! DO IT=1,NPTT
729 ENDDO ! DO ILAY=1,NLAY
730 ENDIF ! IF (NLAY == 1)
731
732 ENDDO ! DO I=1,NEL
733 ENDIF ! IF (MPT == 0)
734 ELSE
735
736 ENDIF ! IF (IHBE == 23)
737 ENDIF ! IF (IW == 0)
738 DEALLOCATE(MATLY, THKLY, POSLY, THK_LY)
739
740 RETURN
subroutine layini(elbuf_str, jft, jlt, geo, igeo, mat, pid, thkly, matly, posly, igtyp, ixfem, ixlay, nlay, npt, isubstack, stack, drape, nft, thk, nel, ratio_thkly, indx_drape, sedrape, numel_drape)
1.15.0