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 39 of file h3d_sol_skin_tensor.F.

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