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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ c_tf_ne()

subroutine c_tf_ne ( type (elbuf_struct_), target elbuf_str,
integer ihbe,
integer nel,
integer npt,
integer mlw,
integer ity,
integer istrain,
integer jj,
wa,
integer iw,
integer nlay,
integer nptr,
integer npts,
integer ithk,
integer nft,
thke,
integer npg,
integer igtyp,
geo,
integer, dimension(npropgi,*) igeo,
integer ixfem,
integer isubstack,
type (stack_ply) stack,
type(drape_), dimension(numelc_drape) drape_sh4n,
type(drape_), dimension(numeltg_drape) drape_sh3n,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer mpt,
type(drapeg_) drapeg )

Definition at line 34 of file c_tf_ne.F.

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