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 35 of file c_tf_ne.F.

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
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:75