OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_skin_tensor.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_skin_tensor (elbuf_tab, skin_tensor, iparg, ixs, x, pm, iparts, ipm, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, iad_elem, fr_elem, weight, tag_skins6)
subroutine tsh_dir2 (x, ixs, dir, dirb, icstr, nel)
subroutine roto_sig2d (jft, jlt, sig, dir)
subroutine tens3dto2d (nel, ixc, x, ten3, ten2)
subroutine rot3dto2d (nel, sig3d, sig2d, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
subroutine reorder_n (n, ic)

Function/Subroutine Documentation

◆ h3d_skin_tensor()

subroutine h3d_skin_tensor ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
skin_tensor,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
x,
pm,
integer, dimension(*) iparts,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) is_written_skin,
integer, dimension(*) h3d_part,
integer info1,
character(len=ncharline100) keyword,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(*) tag_skins6 )

Definition at line 38 of file h3d_skin_tensor.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE initbuf_mod
47 USE elbufdef_mod
48 USE names_and_titles_mod, ONLY: ncharline100
49 use element_mod , only : nixs
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "vect01_c.inc"
58#include "mvsiz_p.inc"
59#include "com01_c.inc"
60#include "com04_c.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65C REAL
66 my_real
67 . skin_tensor(3,*),pm(npropm,*), x(3,*)
68 INTEGER IPARG(NPARG,*),
69 . IXS(NIXS,*),IPM(NPROPMI,*),IPARTS(*),
70 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
71 . IGEO(NPROPGI,*),IS_WRITTEN_SKIN(*),
72 . H3D_PART(*),INFO1,TAG_SKINS6(*),IAD_ELEM(2,*),FR_ELEM(*),WEIGHT(*)
73 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
74 CHARACTER(LEN=NCHARLINE100) :: KEYWORD
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 my_real
79 . evar(3,mvsiz),dir(mvsiz,2),dirb(mvsiz,2)
80 my_real
81 . f_exp,f_str,f_gauss(9)
82 INTEGER I, NEL, NPTR, NPTS, NPTT, NLAY, ILAY,
83 . IR,IS,IT,IL,MLW, NUVAR,IUS,LENF,PTF,PTM,PTS,NFAIL,
84 . N,NN,K,K1,K2,JTURB,MT,IMID,IALEL,IPID,ISH3N,NNI,
85 . NN1,NN2,NN3,NN4,NN5,NN6,NN9,NF,BUF,NVARF,
86 . IHBE,NPTM,NPG, MPT,IPT,IADD,IADR,IPMAT,IFAILT,
87 . IIGEO,IADI,ISUBSTACK,ITHK,
88 . ID_PLY,NB_PLYOFF,NG,NSKIN,ICSTR
89 INTEGER ISOLNOD, IVISC,
90 . ISTRAIN,KCVT,IOR_TSH,MT1,ICSIG,PTI,IOK,IPRT,IOK_PART(MVSIZ),
91 . JJ(6),IS_WRITTEN_TENSOR(MVSIZ),MLWI,MID,PID
92
93 TYPE(G_BUFEL_) ,POINTER :: GBUF
94 TYPE(L_BUFEL_) ,POINTER :: LBUF
95
96C----- facter of extrapolation
97 DATA f_gauss /
98 9 1.000000000000000,1.732050807568877,1.290994448735806,
99 9 1.161256338324528,1.103533701926633,1.072421119155361,
100 9 1.053620970803647,1.041352247171806,1.032886870574820/
101C-----------------------------------------------
102 nskin = 0
103 iok_part(1:mvsiz)=0
104 DO ng=1,ngroup
105 gbuf => elbuf_tab(ng)%GBUF
106 icstr = iparg(17,ng)
107 istrain = iparg(44,ng)
108 isolnod = iparg(28,ng)
109 ivisc = iparg(61,ng)
110 CALL initbuf(iparg ,ng ,
111 2 mlw ,nel ,nft ,iad ,ity ,
112 3 npt ,jale ,ismstr ,jeul ,jtur ,
113 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
114 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
115 6 irep ,iint ,igtyp ,israt ,isrot ,
116 7 icsen ,isorth ,isorthg ,ifailure,jsms )
117!
118 DO i=1,6
119 jj(i) = nel*(i-1)
120 ENDDO
121!
122 IF(mlw == 13 .OR. mlw == 0) cycle
123C-----------------------------------------------
124C THICK-SHELL
125C-----------------------------------------------
126! 8--------------7
127! / | /|
128! 5--------------|6
129! | | | |
130! | 4-----------|-3
131! | / |/
132! 1--------------2
133 IF (ity == 1.AND.(igtyp==20 .OR. igtyp==21 .OR. igtyp==22)) THEN
134 ior_tsh = 0
135 IF (igtyp == 21) THEN
136 ior_tsh = 1
137 ELSEIF (igtyp == 22) THEN
138 ior_tsh = 2
139 END IF
140 IF (kcvt==1.AND.ior_tsh/=0) kcvt=2
141 iok_part(1:nel) = 0
142 DO i=1,nel
143 n = i + nft
144 IF( h3d_part(iparts(n)) == 1) iok_part(i) = 1
145 is_written_tensor(i) = 0
146 evar(1:3,i) = zero
147 ENDDO
148 nlay = elbuf_tab(ng)%NLAY
149 nptr = elbuf_tab(ng)%NPTR
150 npts = elbuf_tab(ng)%NPTS
151 nptt = elbuf_tab(ng)%NPTT
152 IF (igtyp == 22 .AND. nlay>9) THEN
153 f_exp = one
154 ELSE
155 f_exp = f_gauss(nlay)
156 END IF
157 IF (jhbe==14.OR.jhbe==16) f_exp = f_exp/(nptr*npts)
158C-----------------------------------------------
159 IF (keyword == 'TENS/STRESS/OUTER') THEN
160 is_written_tensor(1:nel) = 1
161C-----------------------------------------------
162 ilay=1
163 it = 1
164C-------- grp skin_inf first
165 IF (jhbe==15) THEN
166 ir = 1
167 is = 1
168 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
169 DO i=1,nel
170 evar(1:2,i) = lbuf%SIG(jj(1:2) + i)
171 evar(3,i) = lbuf%SIG(jj(4) + i)
172 ENDDO
173 IF(ivisc > 0) THEN
174 DO i=1,nel
175 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
176 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
177 ENDDO
178 ENDIF
179 ELSE ! 14,16
180 DO ir=1,nptr
181 DO is=1,npts
182 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
183 DO i=1,nel
184 evar(1:2,i) = evar(1:2,i) + lbuf%SIG(jj(1:2) + i)
185 evar(3,i) = evar(3,i) + lbuf%SIG(jj(4) + i)
186 ENDDO
187 IF(ivisc > 0) THEN
188 DO i=1,nel
189 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
190 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
191 ENDDO
192 ENDIF
193 ENDDO
194 ENDDO
195C----------
196 END IF !IF (JHBE==15)
197 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
198C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
199 IF (kcvt==2) THEN
200 IF(ior_tsh==1)THEN
201 DO i=1,nel
202 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
203 ENDDO
204 ELSEIF(ior_tsh==2)THEN
205 IF(jhbe==14)THEN
206 ir = 1
207 is = 1
208 END IF
209 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
210 DO i=1,nel
211 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
212 ENDDO
213 END IF
214 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
215 CALL roto_sig2d(1,nel,evar,dirb)
216 END IF !(KCVT==2) THEN
217 DO i=1,nel
218 n = i + nft
219 skin_tensor(1:3,nskin+i) = evar(1:3,i)
220 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
221 END DO
222 nskin = nskin + nel
223 evar(1:3,1:nel) = zero
224C-------- grp skin_up
225 ilay=nlay
226 it = 1
227 IF (jhbe==15) THEN
228 ir = 1
229 is = 1
230 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
231 DO i=1,nel
232 evar(1:2,i) = lbuf%SIG(jj(1:2) + i)
233 evar(3,i) = lbuf%SIG(jj(4) + i)
234 ENDDO
235 IF(ivisc > 0) THEN
236 DO i=1,nel
237 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
238 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
239 ENDDO
240 ENDIF
241 ELSE ! 14,16
242 DO ir=1,nptr
243 DO is=1,npts
244 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
245 DO i=1,nel
246 evar(1:2,i) = evar(1:2,i) + lbuf%SIG(jj(1:2) + i)
247 evar(3,i) = evar(3,i) + lbuf%SIG(jj(4) + i)
248 ENDDO
249 IF(ivisc > 0) THEN
250 DO i=1,nel
251 evar(1:2,i) = evar(1:2,i) + lbuf%VISC(jj(1:2) + i)
252 evar(3,i) = evar(3,i) + lbuf%VISC(jj(4) + i)
253 ENDDO
254 ENDIF
255 ENDDO
256 ENDDO
257 END IF !IF (JHBE==15)
258 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
259C--- orthotropic
260 IF (kcvt==2) THEN
261 IF(ior_tsh==1)THEN
262 DO i=1,nel
263 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
264 ENDDO
265 ELSEIF(ior_tsh==2)THEN
266 IF(jhbe==14)THEN
267 ir = 1
268 is = 1
269 END IF
270 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
271 DO i=1,nel
272 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
273 ENDDO
274 END IF
275 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
276 CALL roto_sig2d(1,nel,evar,dirb)
277 END IF !(KCVT==2) THEN
278 DO i=1,nel
279 n = i + nft
280 skin_tensor(1:3,nskin+i) = evar(1:3,i)
281 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
282 END DO
283 nskin = nskin + nel
284C-----------------------------------------------
285 ELSEIF (keyword == 'TENS/STRAIN/OUTER') THEN
286C-----------------------------------------------
287 is_written_tensor(1:nel) = 1
288C-------- grp skin_inf first
289 ilay=1
290 it = 1
291 mlwi = mlw
292 IF (igtyp == 22) THEN
293 pid = ixs(nixs-1,1 + nft)
294 mid = igeo(100+ilay,pid)
295 mlwi=nint(pm(19,mid))
296 END IF
297 IF (jhbe==15) THEN
298 ir = 1
299 is = 1
300 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
301 IF (mlwi == 12 .OR. mlwi == 14) THEN
302 DO i=1,nel
303 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
304 evar(3,i) = half*lbuf%EPE(jj(4) + i)
305 ENDDO
306 ELSEIF (mlwi /= 49 ) THEN
307 DO i=1,nel
308 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
309 evar(3,i) = half*lbuf%STRA(jj(4) + i)
310 ENDDO
311 ELSE
312 is_written_tensor(1:nel) = 0
313 END IF
314C------to see if need rotate EVARL
315 ELSE ! 14,16
316 DO ir=1,nptr
317 DO is=1,npts
318 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
319 IF (mlwi == 12 .OR. mlwi == 14) THEN
320 DO i=1,nel
321 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
322 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
323 ENDDO
324 ELSEIF (mlwi /= 49 ) THEN
325 DO i=1,nel
326 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
327 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
328 ENDDO
329 ELSE
330 is_written_tensor(1:nel) = 0
331 END IF
332 ENDDO
333 ENDDO
334 END IF
335 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
336C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
337 IF (kcvt==2) THEN
338 IF(ior_tsh==1)THEN
339 DO i=1,nel
340 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
341 ENDDO
342 ELSEIF(ior_tsh==2)THEN
343 IF(jhbe==14)THEN
344 ir = 1
345 is = 1
346 END IF
347 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
348 DO i=1,nel
349 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
350 ENDDO
351 END IF
352 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
353 CALL roto_sig2d(1,nel,evar,dirb)
354 END IF !(KCVT==2) THEN
355 DO i=1,nel
356 n = i + nft
357 skin_tensor(1:3,nskin+i) = evar(1:3,i)
358 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
359 END DO
360 nskin = nskin + nel
361 evar(1:3,1:nel) = zero
362C-------- grp skin_sup
363 ilay=nlay
364 it = 1
365 mlwi = mlw
366 IF (igtyp == 22) THEN
367 pid = ixs(nixs-1,1 + nft)
368 mid = igeo(100+ilay,pid)
369 mlwi=nint(pm(19,mid))
370 END IF
371 IF (jhbe==15) THEN
372 ir = 1
373 is = 1
374 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
375 IF (mlwi == 12 .OR. mlwi == 14) THEN
376 DO i=1,nel
377 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
378 evar(3,i) = half*lbuf%EPE(jj(4) + i)
379 ENDDO
380 ELSEIF (mlwi /= 49 ) THEN
381 DO i=1,nel
382 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
383 evar(3,i) = half*lbuf%STRA(jj(4) + i)
384 ENDDO
385 ELSE
386 is_written_tensor(1:nel) = 0
387 END IF
388C------to see if need rotate EVARL
389 ELSE ! 14,16
390 DO ir=1,nptr
391 DO is=1,npts
392 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
393 IF (mlwi == 12 .OR. mlwi == 14) THEN
394 DO i=1,nel
395 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
396 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
397 ENDDO
398 ELSEIF (mlwi /= 49 ) THEN
399 DO i=1,nel
400 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
401 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
402 ENDDO
403 ELSE
404 is_written_tensor(1:nel) = 0
405 END IF
406 ENDDO
407 ENDDO
408 END IF
409 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
410C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
411 IF (kcvt==2) THEN
412 IF(ior_tsh==1)THEN
413 DO i=1,nel
414 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
415 ENDDO
416 ELSEIF(ior_tsh==2)THEN
417 IF(jhbe==14)THEN
418 ir = 1
419 is = 1
420 END IF
421 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
422 DO i=1,nel
423 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
424 ENDDO
425 END IF
426 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
427 CALL roto_sig2d(1,nel,evar,dirb)
428 END IF !(KCVT==2) THEN
429 DO i=1,nel
430 n = i + nft
431 skin_tensor(1:3,nskin+i) = evar(1:3,i)
432 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
433 END DO
434 nskin = nskin + nel
435C-----------------------------------------------
436 ELSEIF (keyword == 'TENS/STRAIN/OUTER_AVERAGE') THEN
437C-----------------------------------------------
438 is_written_tensor(1:nel) = 1
439C-------- grp skin_inf first
440 ilay=(1+nlay)/2
441 it = 1
442 mlwi = mlw
443 IF (igtyp == 22) THEN
444 pid = ixs(nixs-1,1 + nft)
445 mid = igeo(100+ilay,pid)
446 mlwi=nint(pm(19,mid))
447 END IF
448 IF (jhbe==15) THEN
449 ir = 1
450 is = 1
451 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
452 IF (mlwi == 12 .OR. mlwi == 14) THEN
453 DO i=1,nel
454 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
455 evar(3,i) = half*lbuf%EPE(jj(4) + i)
456 ENDDO
457 ELSEIF (mlwi /= 49 ) THEN
458 DO i=1,nel
459 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
460 evar(3,i) = half*lbuf%STRA(jj(4) + i)
461 ENDDO
462 ELSE
463 is_written_tensor(1:nel) = 0
464 END IF
465C------to see if need rotate EVARL
466 ELSE ! 14,16
467 DO ir=1,nptr
468 DO is=1,npts
469 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
470 IF (mlwi == 12 .OR. mlwi == 14) THEN
471 DO i=1,nel
472 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
473 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
474 ENDDO
475 ELSEIF (mlwi /= 49 ) THEN
476 DO i=1,nel
477 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
478 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
479 ENDDO
480 ELSE
481 is_written_tensor(1:nel) = 0
482 END IF
483 ENDDO
484 ENDDO
485 END IF
486 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
487C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
488 IF (kcvt==2) THEN
489 IF(ior_tsh==1)THEN
490 DO i=1,nel
491 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
492 ENDDO
493 ELSEIF(ior_tsh==2)THEN
494 IF(jhbe==14)THEN
495 ir = 1
496 is = 1
497 END IF
498 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
499 DO i=1,nel
500 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
501 ENDDO
502 END IF
503 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
504 CALL roto_sig2d(1,nel,evar,dirb)
505 END IF !(KCVT==2) THEN
506 DO i=1,nel
507 skin_tensor(1:3,nskin+i) = evar(1:3,i)
508 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
509 END DO
510 nskin = nskin + nel
511 evar(1:3,1:nel) = zero
512C-------- grp skin_sup
513 ilay=(1+nlay)/2
514 it = 1
515 mlwi = mlw
516 IF (igtyp == 22) THEN
517 pid = ixs(nixs-1,1 + nft)
518 mid = igeo(100+ilay,pid)
519 mlwi=nint(pm(19,mid))
520 END IF
521 IF (jhbe==15) THEN
522 ir = 1
523 is = 1
524 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
525 IF (mlwi == 12 .OR. mlwi == 14) THEN
526 DO i=1,nel
527 evar(1:2,i) = lbuf%EPE(jj(1:2) + i)
528 evar(3,i) = half*lbuf%EPE(jj(4) + i)
529 ENDDO
530 ELSEIF (mlwi /= 49 ) THEN
531 DO i=1,nel
532 evar(1:2,i) = lbuf%STRA(jj(1:2) + i)
533 evar(3,i) = half*lbuf%STRA(jj(4) + i)
534 ENDDO
535 ELSE
536 is_written_tensor(1:nel) = 0
537 END IF
538C------to see if need rotate EVARL
539 ELSE ! 14,16
540 DO ir=1,nptr
541 DO is=1,npts
542 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
543 IF (mlwi == 12 .OR. mlwi == 14) THEN
544 DO i=1,nel
545 evar(1:2,i) = evar(1:2,i)+lbuf%EPE(jj(1:2) + i)
546 evar(3,i) = evar(3,i)+half*lbuf%EPE(jj(4) + i)
547 ENDDO
548 ELSEIF (mlwi /= 49 ) THEN
549 DO i=1,nel
550 evar(1:2,i) = evar(1:2,i)+lbuf%STRA(jj(1:2) + i)
551 evar(3,i) = evar(3,i)+ half*lbuf%STRA(jj(4) + i)
552 ENDDO
553 ELSE
554 is_written_tensor(1:nel) = 0
555 END IF
556 ENDDO
557 ENDDO
558 END IF
559 evar(1:3,1:nel) = f_exp*evar(1:3,1:nel)
560C------to see if need rotate EVAR, Isolid=16 incompatible to orthotropic
561 IF (kcvt==2) THEN
562 IF(ior_tsh==1)THEN
563 DO i=1,nel
564 dir(i,1:2)= gbuf%GAMA(jj(1:2) + i)
565 ENDDO
566 ELSEIF(ior_tsh==2)THEN
567 IF(jhbe==14)THEN
568 ir = 1
569 is = 1
570 END IF
571 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
572 DO i=1,nel
573 dir(i,1:2)= lbuf%GAMA(jj(1:2) + i)
574 ENDDO
575 END IF
576 CALL tsh_dir2(x,ixs,dir,dirb,icstr,nel)
577 CALL roto_sig2d(1,nel,evar,dirb)
578 END IF !(KCVT==2) THEN
579 DO i=1,nel
580 skin_tensor(1:3,nskin+i) = evar(1:3,i)
581 IF(iok_part(i) == 1 ) is_written_skin(nskin+i) = is_written_tensor(i)
582 END DO
583 nskin = nskin + nel
584 END IF !(KEYWORD
585 ENDIF !IF (ITY == 1.AND.(IGTYP==20
586C
587 END DO ! NG=1,NGROUP
588C------for solid elements
589 IF (numskin> nskin)
590 . CALL h3d_sol_skin_tensor(
591 . elbuf_tab,skin_tensor, iparg ,ixs ,x ,pm ,
592 4 iparts ,ipm ,igeo ,ixs10 ,ixs16 , ixs20 ,
593 5 is_written_skin ,h3d_part,info1 ,keyword ,nskin ,
594 6 iad_elem ,fr_elem , weight ,tag_skins6)
595C-----------
596 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
tsh_dir2
subroutine tsh_dir2(x, ixs, dir, dirb, icstr, nel)
Definition h3d_skin_tensor.F:610
roto_sig2d
subroutine roto_sig2d(jft, jlt, sig, dir)
Definition h3d_skin_tensor.F:779
h3d_sol_skin_tensor
subroutine h3d_sol_skin_tensor(elbuf_tab, skin_tensor, iparg, ixs, x, pm, iparts, ipm, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, nskin, iad_elem, fr_elem, weight, tag_skins6)
Definition h3d_sol_skin_tensor.F:45
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1007

◆ reorder_n()

subroutine reorder_n ( integer n,
integer, dimension(*) ic )

Definition at line 945 of file h3d_skin_tensor.F.

946C----6---------------------------------------------------------------7---------8
947C I m p l i c i t T y p e s
948C-----------------------------------------------
949#include "implicit_f.inc"
950C-----------------------------------------------------------------
951C D u m m y A r g u m e n t s
952C-----------------------------------------------
953 INTEGER N ,IC(*)
954C-----------------------------------------------
955C L o c a l V a r i a b l e s
956C-----------------------------------------------
957 INTEGER I,J,IMIN,IT,II
958C
959 IF (n<=0) RETURN
960 DO i =1,n
961 imin=ic(i)
962 ii=i
963 DO j =i+1,n
964 IF (ic(j)<imin) THEN
965 imin=ic(j)
966 ii=j
967 ENDIF
968 ENDDO
969 it=ic(i)
970 ic(i)=imin
971 ic(ii)=it
972 ENDDO
973C----6---------------------------------------------------------------7---------8
974 RETURN

◆ rot3dto2d()

subroutine rot3dto2d ( integer nel,
sig3d,
sig2d,
g1x,
g1y,
g1z,
g2x,
g2y,
g2z,
g3x,
g3y,
g3z )

Definition at line 908 of file h3d_skin_tensor.F.

910C-----------------------------------------------
911C I m p l i c i t T y p e s
912C-----------------------------------------------
913#include "implicit_f.inc"
914C-----------------------------------------------
915C D u m m y A r g u m e n t s
916C-----------------------------------------------
917 INTEGER NEL
918 my_real
919 . sig3d(6,*),sig2d(3,*), g1x(*),g1y(*),g1z(*),
920 . g2x(*),g2y(*),g2z(*),g3x(*),g3y(*),g3z(*)
921C-----------------------------------------------
922C L o c a l V a r i a b l e s
923C-----------------------------------------------
924 INTEGER I
925 my_real
926 . sx,sy,sz
927C-----------------------------------------------
928 DO i=1,nel
929 sx = sig3d(1,i)*g1x(i)+sig3d(4,i)*g1y(i)+sig3d(6,i)*g1z(i)
930 sy = sig3d(4,i)*g1x(i)+sig3d(2,i)*g1y(i)+sig3d(5,i)*g1z(i)
931 sz = sig3d(6,i)*g1x(i)+sig3d(5,i)*g1y(i)+sig3d(3,i)*g1z(i)
932 sig2d(1,i) = sx*g1x(i)+sy*g1y(i)+sz*g1z(i)
933 sig2d(3,i) = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
934 sx = sig3d(1,i)*g2x(i)+sig3d(4,i)*g2y(i)+sig3d(6,i)*g2z(i)
935 sy = sig3d(4,i)*g2x(i)+sig3d(2,i)*g2y(i)+sig3d(5,i)*g2z(i)
936 sz = sig3d(6,i)*g2x(i)+sig3d(5,i)*g2y(i)+sig3d(3,i)*g2z(i)
937 sig2d(2,i) = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
938 ENDDO
939C-----------
940 RETURN

◆ roto_sig2d()

subroutine roto_sig2d ( integer jft,
integer jlt,
sig,
dir )

Definition at line 778 of file h3d_skin_tensor.F.

779C-----------------------------------------------
780C I m p l i c i t T y p e s
781C-----------------------------------------------
782#include "implicit_f.inc"
783C-----------------------------------------------
784C G l o b a l P a r a m e t e r s
785C-----------------------------------------------
786#include "mvsiz_p.inc"
787C-----------------------------------------------
788C D u m m y A r g u m e n t s
789C-----------------------------------------------
790 INTEGER JFT, JLT
791 my_real
792 . sig(3,mvsiz), dir(mvsiz,2)
793C-----------------------------------------------
794C L o c a l V a r i a b l e s
795C-----------------------------------------------
796 INTEGER I
797 my_real
798 . x2,y2,xy,xys2,sign(3)
799C-----------------------------------------------
800 DO i=jft,jlt
801 x2=dir(i,1)*dir(i,1)
802 y2=dir(i,2)*dir(i,2)
803 xy=dir(i,1)*dir(i,2)
804 xys2=two*xy*sig(3,i)
805 sign(1) = x2*sig(1,i)+y2*sig(2,i)-xys2
806 sign(2) = y2*sig(1,i)+x2*sig(2,i)+xys2
807 sign(3) =(sig(1,i)-sig(2,i))*xy+(x2-y2)*sig(3,i)
808 sig(1,i) = sign(1)
809 sig(2,i) = sign(2)
810 sig(3,i) = sign(3)
811 ENDDO
812C-----------
813 RETURN

◆ tens3dto2d()

subroutine tens3dto2d ( integer nel,
integer, dimension(5,*) ixc,
x,
ten3,
ten2 )

Definition at line 824 of file h3d_skin_tensor.F.

825C-----------------------------------------------
826C I m p l i c i t T y p e s
827C-----------------------------------------------
828#include "implicit_f.inc"
829C-----------------------------------------------
830C G l o b a l P a r a m e t e r s
831C-----------------------------------------------
832#include "mvsiz_p.inc"
833C-----------------------------------------------
834C D u m m y A r g u m e n t s
835C-----------------------------------------------
836 INTEGER NEL,IXC(5,*)
837 my_real
838 . x(3,*),ten3(6,*),ten2(3,*)
839C-----------------------------------------------
840C L o c a l V a r i a b l e s
841C-----------------------------------------------
842 INTEGER I, K
843 INTEGER
844 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ)
845C REAL
846 my_real
847 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
848 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
849 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
850 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,
851 . sx(mvsiz) ,sy(mvsiz) ,sz(mvsiz) ,
852 . tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
853 . e1x(mvsiz),e2x(mvsiz),e3x(mvsiz),
854 . e1y(mvsiz),e2y(mvsiz),e3y(mvsiz),
855 . e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),
856 . deta1(mvsiz),offg(mvsiz),tens(6,mvsiz)
857C-----------------------------------------------
858 DO i=1,nel
859 ix1(i)=ixc(2,i)
860 ix2(i)=ixc(3,i)
861 ix3(i)=ixc(4,i)
862 ix4(i)=ixc(5,i)
863 x1(i)=x(1,ix1(i))
864 y1(i)=x(2,ix1(i))
865 z1(i)=x(3,ix1(i))
866 x2(i)=x(1,ix2(i))
867 y2(i)=x(2,ix2(i))
868 z2(i)=x(3,ix2(i))
869 x3(i)=x(1,ix3(i))
870 y3(i)=x(2,ix3(i))
871 z3(i)=x(3,ix3(i))
872 x4(i)=x(1,ix4(i))
873 y4(i)=x(2,ix4(i))
874 z4(i)=x(3,ix4(i))
875 ENDDO
876 DO i=1,nel
877 rx(i)=x2(i)+x3(i)-x1(i)-x4(i)
878 sx(i)=x3(i)+x4(i)-x1(i)-x2(i)
879 ry(i)=y2(i)+y3(i)-y1(i)-y4(i)
880 sy(i)=y3(i)+y4(i)-y1(i)-y2(i)
881 rz(i)=z2(i)+z3(i)-z1(i)-z4(i)
882 sz(i)=z3(i)+z4(i)-z1(i)-z2(i)
883 ENDDO
884 k = 0
885 offg(1:nel) = one
886 CALL clskew3(1,nel,k,
887 . rx, ry, rz,
888 . sx, sy, sz,
889 . e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z,
890 . deta1,offg )
891 DO i=1,nel
892 IF (ix3(i)==ix4(i)) THEN
893 tens(1:6,i) = third*(ten3(1:6,ix1(i))+ten3(1:6,ix2(i))+ten3(1:6,ix3(i)))
894 ELSE
895 tens(1:6,i) = fourth*(ten3(1:6,ix1(i))+ten3(1:6,ix2(i))
896 . +ten3(1:6,ix3(i))+ten3(1:6,ix4(i)))
897 END IF
898 ENDDO
899 CALL rot3dto2d(nel,tens,ten2,e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
900C-----------
901 RETURN
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
rot3dto2d
subroutine rot3dto2d(nel, sig3d, sig2d, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
Definition h3d_skin_tensor.F:910

◆ tsh_dir2()

subroutine tsh_dir2 ( x,
integer, dimension(nixs,*) ixs,
dir,
dirb,
integer icstr,
integer nel )

Definition at line 609 of file h3d_skin_tensor.F.

610 use element_mod , only : nixs
611C-----------------------------------------------
612C I m p l i c i t T y p e s
613C-----------------------------------------------
614#include "implicit_f.inc"
615C-----------------------------------------------
616C G l o b a l P a r a m e t e r s
617C-----------------------------------------------
618#include "mvsiz_p.inc"
619C-----------------------------------------------
620C C o m m o n B l o c k s
621C-----------------------------------------------
622#include "vect01_c.inc"
623C-----------------------------------------------
624C D u m m y A r g u m e n t s
625C-----------------------------------------------
626 INTEGER ICSTR,NEL,IXS(NIXS,*)
627 my_real
628 . x(3,*),dir(mvsiz,2),dirb(mvsiz,2)
629C-----------------------------------------------
630C L o c a l V a r i a b l e s
631C-----------------------------------------------
632 INTEGER I
633 INTEGER
634 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),IX5(MVSIZ),
635 . IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ)
636C REAL
637 my_real
638 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
639 . x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
640 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
641 . y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
642 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
643 . z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
644 . rx(mvsiz) , ry(mvsiz) , rz(mvsiz) ,
645 . sx(mvsiz) , sy(mvsiz) , sz(mvsiz) ,
646 . tx(mvsiz) , ty(mvsiz) , tz(mvsiz) ,
647 . e1x(mvsiz),e2x(mvsiz),e3x(mvsiz),
648 . e1y(mvsiz),e2y(mvsiz),e3y(mvsiz),
649 . e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),
650 . v1,v2,v3,vr,vs,aa,bb,suma
651C-----------------------------------------------
652 IF (irep == 0) THEN
653 DO i=1,nel
654 dirb(i,1) = dir(i,1)
655 dirb(i,2) = dir(i,2)
656 ENDDO
657 ELSE
658 DO i=1,nel
659 ix1(i)=ixs(2,i)
660 ix2(i)=ixs(3,i)
661 ix3(i)=ixs(4,i)
662 ix4(i)=ixs(5,i)
663 ix5(i)=ixs(6,i)
664 ix6(i)=ixs(7,i)
665 ix7(i)=ixs(8,i)
666 ix8(i)=ixs(9,i)
667 x1(i)=x(1,ix1(i))
668 y1(i)=x(2,ix1(i))
669 z1(i)=x(3,ix1(i))
670 x2(i)=x(1,ix2(i))
671 y2(i)=x(2,ix2(i))
672 z2(i)=x(3,ix2(i))
673 x3(i)=x(1,ix3(i))
674 y3(i)=x(2,ix3(i))
675 z3(i)=x(3,ix3(i))
676 x4(i)=x(1,ix4(i))
677 y4(i)=x(2,ix4(i))
678 z4(i)=x(3,ix4(i))
679 x5(i)=x(1,ix5(i))
680 y5(i)=x(2,ix5(i))
681 z5(i)=x(3,ix5(i))
682 x6(i)=x(1,ix6(i))
683 y6(i)=x(2,ix6(i))
684 z6(i)=x(3,ix6(i))
685 x7(i)=x(1,ix7(i))
686 y7(i)=x(2,ix7(i))
687 z7(i)=x(3,ix7(i))
688 x8(i)=x(1,ix8(i))
689 y8(i)=x(2,ix8(i))
690 z8(i)=x(3,ix8(i))
691 ENDDO
692 CALL srepisot3(
693 1 x1, x2, x3, x4,
694 2 x5, x6, x7, x8,
695 3 y1, y2, y3, y4,
696 4 y5, y6, y7, y8,
697 5 z1, z2, z3, z4,
698 6 z5, z6, z7, z8,
699 7 rx, ry, rz, sx,
700 8 sy, sz, tx, ty,
701 9 tz, nel)
702 CALL scortho3(
703 1 rx, ry, rz, sx,
704 2 sy, sz, tx, ty,
705 3 tz, e1x, e2x, e3x,
706 4 e1y, e2y, e3y, e1z,
707 5 e2z, e3z, nel)
708 IF (jhbe == 15) THEN
709 DO i=1,nel
710 aa = dir(i,1)
711 bb = dir(i,2)
712 v1 = aa*tx(i) + bb*rx(i)
713 v2 = aa*ty(i) + bb*ry(i)
714 v3 = aa*tz(i) + bb*rz(i)
715 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
716 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
717 suma=sqrt(vr*vr + vs*vs)
718 suma=one/max(em20,suma)
719 dirb(i,1) = vr*suma
720 dirb(i,2) = vs*suma
721 ENDDO
722 ELSEIF (jhbe == 14) THEN
723 SELECT CASE (icstr)
724 CASE (1)
725 DO i=1,nel
726 aa = dir(i,1)
727 bb = dir(i,2)
728 v1 = aa*rx(i) + bb*sx(i)
729 v2 = aa*ry(i) + bb*sy(i)
730 v3 = aa*rz(i) + bb*sz(i)
731 vr=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
732 vs=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
733 suma=sqrt(vr*vr + vs*vs)
734 suma=one/max(em20,suma)
735 dirb(i,1) = vr*suma
736 dirb(i,2) = vs*suma
737 ENDDO
738 CASE (100)
739 DO i=1,nel
740 aa = dir(i,1)
741 bb = dir(i,2)
742 v1 = aa*sx(i) + bb*tx(i)
743 v2 = aa*sy(i) + bb*ty(i)
744 v3 = aa*sz(i) + bb*tz(i)
745 vr=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
746 vs=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
747 suma=sqrt(vr*vr + vs*vs)
748 suma=one/max(em20,suma)
749 dirb(i,1) = vr*suma
750 dirb(i,2) = vs*suma
751 ENDDO
752 CASE (10)
753 DO i=1,nel
754 aa = dir(i,1)
755 bb = dir(i,2)
756 v1 = aa*tx(i) + bb*rx(i)
757 v2 = aa*ty(i) + bb*ry(i)
758 v3 = aa*tz(i) + bb*rz(i)
759 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
760 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
761 suma=sqrt(vr*vr + vs*vs)
762 suma=one/max(em20,suma)
763 dirb(i,1) = vr*suma
764 dirb(i,2) = vs*suma
765 ENDDO
766 END SELECT
767 END IF !(jhbe == 15) THEN
768 ENDIF
769C-----------
770 RETURN
max
#define max(a, b)
Definition macros.h:21
srepisot3
subroutine srepisot3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel)
Definition srepisot3.F:42
scortho3
subroutine scortho3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition scortho3.F:34