OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_sol_skin_tensor.F File Reference
#include "implicit_f.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_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)

Function/Subroutine Documentation

◆ h3d_sol_skin_tensor()

subroutine h3d_sol_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 nskin,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(*) tag_skins6 )

Definition at line 40 of file h3d_sol_skin_tensor.F.

45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE initbuf_mod
49 USE elbufdef_mod
50 USE names_and_titles_mod, ONLY: ncharline100
51 use element_mod , only : nixs
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66C REAL
67 my_real
68 . skin_tensor(3,*),pm(npropm,*), x(3,*)
69 INTEGER IPARG(NPARG,*),
70 . IXS(NIXS,*),IPM(NPROPMI,*),IPARTS(*),
71 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
72 . IGEO(NPROPGI,*),IS_WRITTEN_SKIN(*),
73 . H3D_PART(*),INFO1,NSKIN,TAG_SKINS6(*),IAD_ELEM(2,*),FR_ELEM(*),WEIGHT(*)
74 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
75 CHARACTER(LEN=NCHARLINE100):: KEYWORD
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 my_real
80 . evar(3,mvsiz)
81 INTEGER I, II, J, LENR, NEL, NFT, N
82 INTEGER IOK_PART(MVSIZ), TAG_SKIN_ND(NUMNOD)
83
84 INTEGER IXSKIN(7, NUMSKIN), IXSK(5, MVSIZ), IDEB
85 INTEGER JJ
86
87
88
89 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGPS
90 my_real
91 . , DIMENSION(:,:), ALLOCATABLE :: aflu, vflu,VALUE
92 INTEGER FACES(4,6),NS,K1,PWR(7),LL
93 DATA pwr/1,2,4,8,16,32,64/
94 DATA faces/4,3,2,1,
95 . 5,6,7,8,
96 . 1,2,6,5,
97 . 3,4,8,7,
98 . 2,3,7,6,
99 . 1,5,8,4/
100C-----------------------------------------------
101C
102 ALLOCATE(aflu(3,numnod),vflu(3,numnod),value(6,numnod))
103 ALLOCATE(itagps(numnod))
104 aflu = zero
105 vflu = zero
106 VALUE = zero
107 itagps = 0
108C------TAG_SKIN_ND only the big seg(mid-node of S10 not include)
109 tag_skin_nd(1:numnod) = 0
110 DO i=1,numels
111 ll=tag_skins6(i)
112 DO jj=1,6
113 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
114 DO k1=1,4
115 ns=ixs(faces(k1,jj)+1,i)
116 tag_skin_nd(ns) = 1
117 END DO
118 END DO
119 END DO
120 iok_part(1:mvsiz)=0
121 IF (keyword == 'TENS/STRESS/OUTER') THEN
122 CALL tensgps_skin(elbuf_tab,vflu ,aflu ,iparg ,
123 . ixs ,ixs10 ,ixs16 ,ixs20 ,
124 . x ,itagps ,pm ,tag_skin_nd)
125
126 IF(nspmd > 1)THEN
127 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
128 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
129 DO j=1,3
130 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
131 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
132 ENDDO
133 ENDIF
134 DO j=1,3
135 DO n=1,numnod
136 IF (itagps(n)>0) value(j,n)=vflu(j,n)/itagps(n)
137 ENDDO
138 ENDDO
139 DO j=4,6
140 DO n=1,numnod
141 IF (itagps(n)>0) value(j,n)=aflu(j-3,n)/itagps(n)
142 ENDDO
143 ENDDO
144 ELSEIF (keyword == 'TENS/STRAIN/OUTER') THEN
145 CALL gpsstrain_skin(elbuf_tab,vflu ,aflu ,iparg ,
146 . ixs ,ixs10 ,ixs16 ,ixs20 ,x ,
147 . itagps ,pm ,tag_skin_nd )
148 IF(nspmd > 1)THEN
149 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
150 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
151 DO j=1,3
152 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
153 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
154 ENDDO
155 ENDIF
156 DO j=1,3
157 DO n=1,numnod
158 IF (itagps(n)>0) value(j,n)=vflu(j,n)/itagps(n)
159 ENDDO
160 ENDDO
161C------------change shear to eij
162 DO j=4,6
163 DO n=1,numnod
164 IF (itagps(n)>0) value(j,n)=half*aflu(j-3,n)/itagps(n)
165 ENDDO
166 ENDDO
167 END IF
168C
169 nft = nskin
170 ixskin(1:7,1:numskin)=0
171 CALL h3d_sol_skin_ixskin(elbuf_tab,iparg,iparts,ixs,ixs10,
172 . ixskin ,tag_skins6,nskin )
173 ideb = nft
174 DO i=nft+1,nskin,mvsiz
175 nel = min(nskin-ideb,mvsiz)
176 DO ii = 1, nel
177 n = ii+ideb
178 ixsk(1:5,ii) = ixskin(1:5,n)
179C-------------check for strain case still eij=0.5*shear
180 END DO ! II = 1, NEL
181 CALL tens3dto2d(nel,ixsk,x,VALUE,evar)
182 IF (keyword == 'TENS/STRAIN/OUTER') THEN
183 DO ii=1,nel
184 n = ii+ideb
185 skin_tensor(1:3,n) = evar(1:3,ii)
186 IF(h3d_part(ixsk(1,ii)) == 1) is_written_skin(n) = 1
187 END DO
188 ELSEIF (keyword == 'TENS/STRESS/OUTER') THEN
189 DO ii=1,nel
190 n = ii+ideb
191 skin_tensor(1:3,n) = evar(1:3,ii)
192 IF(h3d_part(ixsk(1,ii)) == 1) is_written_skin(n) = 1
193 END DO
194 END IF
195 ideb = ideb + nel
196 END DO
197 DEALLOCATE(aflu,vflu,VALUE,itagps)
198C-----------
199 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
tens3dto2d
subroutine tens3dto2d(nel, ixc, x, ten3, ten2)
Definition h3d_skin_tensor.F:825
h3d_sol_skin_ixskin
subroutine h3d_sol_skin_ixskin(elbuf_tab, iparg, iparts, ixs, ixs10, ixskin, tag_skins6, nskin)
Definition h3d_sol_skin_ixskin.F:37
min
#define min(a, b)
Definition macros.h:20
initbuf_mod
Definition initbuf.F:160
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
spmd_exch_nodarea2
subroutine spmd_exch_nodarea2(nodarea, iad_elem, fr_elem, lenr, weight, jj)
Definition spmd_exch_nodarea2.F:39
spmd_exch_nodareai
subroutine spmd_exch_nodareai(nodareai, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodareai.F:38
gpsstrain_skin
subroutine gpsstrain_skin(elbuf_tab, func1, func2, iparg, ixs, ixs10, ixs16, ixs20, x, itagps, pm, tag_skin_nd)
Definition tensgpstrain.F:610
tensgps_skin
subroutine tensgps_skin(elbuf_tab, func1, func2, iparg, ixs, ixs10, ixs16, ixs20, x, itagps, pm, tag_skin_nd)
Definition tensor6.F:4762