OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_tf_ne.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| c_tf_ne ../engine/source/output/sty/c_tf_ne.F
25!||--- called by ------------------------------------------------------
26!|| outp_c_tf ../engine/source/output/sty/outp_c_t.F
27!||--- calls -----------------------------------------------------
28!|| layini ../engine/source/elements/shell/coque/layini.F
29!||--- uses -----------------------------------------------------
30!|| drape_mod ../engine/share/modules/drape_mod.F
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| stack_mod ../engine/share/modules/stack_mod.F
34!||====================================================================
35 SUBROUTINE c_tf_ne(ELBUF_STR,IHBE ,NEL ,NPT ,MLW ,
36 . ITY ,ISTRAIN ,JJ ,WA ,IW ,
37 . NLAY ,NPTR ,NPTS ,ITHK ,NFT ,
38 . THKE ,NPG ,IGTYP,GEO ,IGEO ,
39 . IXFEM ,ISUBSTACK,STACK,DRAPE_SH4N, DRAPE_SH3N,
40 . IXC ,IXTG ,MPT ,DRAPEG )
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45 USE stack_mod
46 USE drape_mod
47 use element_mod , only : nixc,nixtg
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "units_c.inc"
59#include "scr16_c.inc"
60C
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IHBE,NEL,NPT,JJ,MLW,ITY,ISTRAIN,IW,NLAY,
65 . NPTR,NPTS,ITHK,NFT,NPG,IGTYP,IGEO(NPROPGI,*),
66 . IXFEM,ISUBSTACK,IXC(NIXC,*),
67 . IXTG(NIXTG,*),MPT
68 my_real
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
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,J,K,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 MAT(MVSIZ),PID(MVSIZ)
83 my_real
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 /
118C
119 TYPE(buf_lay_) ,POINTER :: BUFLY
120 TYPE(G_BUFEL_) ,POINTER :: GBUF
121 TYPE(L_BUFEL_) ,POINTER :: LBUF
122C-----------------------------------------------
123 GBUF => elbuf_str%GBUF
124!
125 DO i=1,12 ! length max of GBUF%G_HOURG = 12
126 ii(i) = nel*(i-1)
127 ENDDO
128!
129 ! Npt_max
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
143C
144 shift = 1+nft
145 IF (ity == 7) shift = shift + numelc
146C
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
158C
159 ixlay = 0
160C
161 IF(ity == 7) THEN
162 numel_drape = numeltg_drape
163 sedrape = stdrape
164 CALL layini(
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
171 numel_drape = numelc_drape
172 sedrape = scdrape
173 CALL layini(
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
180C------------------------
181C STRESS
182C------------------------
183 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
184C
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
202C
203 IF (iw == 0) THEN
204C
205C------SMP-USE--------------
206C
207 IF (ihbe == 23) THEN ! QEPH
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
224c
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 ! DO K=1,NPG
264 ENDDO ! DO I=1,NEL
265c---
266 ELSE ! QEPH, MPT > 0
267c---
268 DO i=1,nel
269!! I5 = (I-1) * 2
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
287C
288 IF (nlay == 1) THEN
289 bufly => elbuf_str%BUFLY(1)
290 nptt = bufly%NPTT ! MPT = 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 ! DO K=1,NPG
318 ENDDO ! DO IT = 1,NPTT
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 ! count all NPTT through all layers
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)
341C
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 ! DO K=1,NPG
353 ENDDO ! DO IT=1,NPTT
354 ipt_all = ipt_all + nptt
355 ENDDO ! DO ILAY = 1,NLAY
356 ENDIF ! IF (NLAY == 1)
357 ENDDO ! DO I=1,NEL
358 ENDIF ! IF (MPT == 0)
359c------
360 ELSEIF (ihbe == 11) THEN ! QBAT,DKT18
361c------
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
384C---
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 ! DO IR=1,NPTR
416 ENDDO ! DO IS=1,NPTS
417 ENDDO ! DO I=1,NEL
418c---
419 ELSE ! MPT > 0
420 DO i=1,nel
421!! I5 = (I-1) * 2
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
439c---
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)
493c---
494 ENDDO ! DO I=1,NEL
495 ENDIF ! IF (MPT == 0)
496 ELSE ! IF (IHBE == 23)
497C----error message------
498 ENDIF
499C
500C------SPMD-USE--------------
501C
502 ELSE ! IF (IW == 1)
503C---QEPH:------
504 IF (ihbe == 23) THEN
505C---Transfer to QBAT------
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
522C
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
564C
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)
576C
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)
585C
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)
616C
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
631C-------QBAT,DKT18-----
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
649C---
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
670c---
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
685c---
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)
731c---
732 ENDDO ! DO I=1,NEL
733 ENDIF ! IF (MPT == 0)
734 ELSE
735C----error message------
736 ENDIF ! IF (IHBE == 23)
737 ENDIF ! IF (IW == 0)
738 DEALLOCATE(matly, thkly, posly, thk_ly)
739C-----------
740 RETURN
741 END
c_tf_ne
subroutine c_tf_ne(elbuf_str, ihbe, nel, npt, mlw, ity, istrain, jj, wa, iw, nlay, nptr, npts, ithk, nft, thke, npg, igtyp, geo, igeo, ixfem, isubstack, stack, drape_sh4n, drape_sh3n, ixc, ixtg, mpt, drapeg)
Definition c_tf_ne.F:41
layini
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)
Definition layini.F:47
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
drape_mod::scdrape
integer scdrape
Definition drape_mod.F:92
drape_mod::stdrape
integer stdrape
Definition drape_mod.F:92
stack_mod
Definition stack_mod.F:75
drape_mod::drape_
Definition drape_mod.F:71