OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4lagsfem.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s4lagsfem (iparg, ixs, x, v, elbuf_tab, sfem_nodvar, s_sfem_nodvar, iad_elem, fr_elem, ixs10, xdp, sxdp, numnod, sfr_elem, nspmd, numels, numels8, numels10, nparg, ngroup, iresp)

Function/Subroutine Documentation

◆ s4lagsfem()

subroutine s4lagsfem ( integer, dimension(nparg,ngroup) iparg,
integer, dimension(nixs,numels) ixs,
dimension(3*numnod), intent(in) x,
dimension(3*numnod), intent(in) v,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
dimension(s_sfem_nodvar), intent(inout) sfem_nodvar,
integer, intent(in) s_sfem_nodvar,
integer, dimension(2,nspmd+1) iad_elem,
integer, dimension(sfr_elem) fr_elem,
integer, dimension(6,numels10) ixs10,
double precision, dimension(sxdp), intent(in) xdp,
integer, intent(in) sxdp,
integer, intent(in) numnod,
integer, intent(in) sfr_elem,
integer, intent(in) nspmd,
integer, intent(in) numels,
integer, intent(in) numels8,
integer, intent(in) numels10,
integer, intent(in) nparg,
integer, intent(in) ngroup,
integer, intent(in) iresp )
Parameters
[in]sxdpsize for array declaration
[in]numels10number of elements
[in]ngroupsizes for data structure IPARG
[in]numnodnumber of nodes (/NODE)
[in]nspmdnumber of SPMD domain

Definition at line 40 of file s4lagsfem.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE initbuf_mod
47 USE elbufdef_mod
48 use element_mod , only : nixs
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "vect01_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER,INTENT(IN) :: S_SFEM_NODVAR, SFR_ELEM, SXDP !< size for array declaration
65 INTEGER,INTENT(IN) :: NUMELS, NUMELS8, NUMELS10 !< number of elements
66 INTEGER,INTENT(IN) :: NPARG, NGROUP !< sizes for data structure IPARG
67 INTEGER,INTENT(IN) :: NUMNOD !< number of nodes (/NODE)
68 INTEGER,INTENT(IN) :: IRESP
69 INTEGER,INTENT(IN) :: NSPMD !< number of SPMD domain
70 INTEGER IXS(NIXS,NUMELS),IPARG(NPARG,NGROUP),IAD_ELEM(2,NSPMD+1),FR_ELEM(SFR_ELEM),IXS10(6,NUMELS10)
71 my_real, INTENT(IN) :: x(3*numnod),v(3*numnod)
72 my_real,intent(inout) :: sfem_nodvar(s_sfem_nodvar)
73 DOUBLE PRECISION , DIMENSION(SXDP), INTENT(IN) :: XDP
74 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER NG, I, J, I1, I2, I3, I4, K, LENR,NEL,NNOD,ICPRE,IBID,IP
79 INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),NC4(MVSIZ),NC(MVSIZ,10)
80 my_real vol0(mvsiz),volg(mvsiz)
81
82 DOUBLE PRECISION VOL06(6,MVSIZ), VARNOD6(6,2*NUMNOD)
83
84 TYPE(G_BUFEL_) ,POINTER :: GBUF
85 TYPE(L_BUFEL_) ,POINTER :: LBUF
86C-----------------------------------------------
87C S o u r c e L i n e s
88C-----------------------------------------------
89 sfem_nodvar(1:2*numnod) = zero
90 varnod6(1:6,1:2*numnod) = zero
91 vol06(1:6,1:mvsiz) = zero
92 vol0(1:mvsiz) = zero
93C---------------------------------------------------
94C COMPUTE NODAL VOLUME FOR ALL TETRAHEDRON
95C---------------------------------------------------
96C SMP loop
97C
98 DO ng = 1,ngroup
99 IF(iparg(8, ng) == 1) cycle
100 nnod = iparg(28,ng)
101 icpre = iparg(10,ng)
102 IF(nnod/=4 .AND. nnod /= 10) cycle
103 CALL initbuf(iparg ,ng ,
104 2 mtn ,llt ,nft ,iad ,ity ,
105 3 npt ,jale ,ismstr ,jeul ,jtur ,
106 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
107 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
108 6 irep ,iint ,igtyp ,israt ,isrot ,
109 7 icsen ,isorth ,isorthg ,ifailure,jsms )
110
111 IF(jeul == 1) cycle
112 IF(jale == 1) cycle
113 IF(nnod == 4 .AND. isrot /= 3) cycle
114 IF(icpre == 0 .AND. (nnod == 10 .OR. (nnod == 4 .AND. isrot == 1))) cycle
115 lft=1
116 nel = llt
117
118 DO i=lft,llt
119 j=i+nft
120 nc1(i)=ixs(2,j)
121 nc2(i)=ixs(4,j)
122 nc3(i)=ixs(7,j)
123 nc4(i)=ixs(6,j)
124 ENDDO
125
126 gbuf => elbuf_tab(ng)%GBUF
127 IF(nnod==4 .AND. isrot == 3) THEN
128 CALL s4volnod3(
129 1 varnod6, x, nc1, nc2,
130 2 nc3, nc4, gbuf%OFF, xdp,
131 3 nel, ismstr)
132 IF(iresp==1)THEN
133 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
134 DO i=lft,llt
135 IF(gbuf%OFF(i) == zero) THEN
136 vol0(i)=zero
137 ELSE
138 vol0(i)=lbuf%VOL0DP(i)
139 ENDIF
140 ENDDO
141 ELSE
142 DO i=lft,llt
143 IF(gbuf%OFF(i) == zero) THEN
144 vol0(i)=zero
145 ELSE
146 vol0(i)=gbuf%VOL(i)
147 ENDIF
148 ENDDO
149 END IF !(IRESP==1)THEN
150C-----for small strain elements
151 CALL s4volnod_sm(
152 1 varnod6, v, nc1, nc2,
153 2 nc3, nc4, vol0, gbuf%AMU,
154 3 gbuf%OFF, gbuf%SMSTR, nel, ismstr)
155 !Parith-On treatment
156 CALL foat_to_6_float(lft ,llt ,vol0 ,vol06 )
157 DO i=lft,llt
158 i1=nc1(i)+numnod
159 i2=nc2(i)+numnod
160 i3=nc3(i)+numnod
161 i4=nc4(i)+numnod
162 !Parith-On treatment
163 DO k=1,6
164 varnod6(k,i1) = varnod6(k,i1) + vol06(k,i)
165 varnod6(k,i2) = varnod6(k,i2) + vol06(k,i)
166 varnod6(k,i3) = varnod6(k,i3) + vol06(k,i)
167 varnod6(k,i4) = varnod6(k,i4) + vol06(k,i)
168 ENDDO
169 ENDDO
170 ELSE
171C-----T10 large strain first
172 nc(lft:llt,1) =nc1(lft:llt)
173 nc(lft:llt,2) =nc2(lft:llt)
174 nc(lft:llt,3) =nc3(lft:llt)
175 nc(lft:llt,4) =nc4(lft:llt)
176 IF(isrot /= 1)THEN
177 DO i=lft,llt
178 j=i+nft-numels8
179 nc(i,5:10) =ixs10(1:6,j)
180 ENDDO
181 ELSE
182 nc(lft:llt,5:10) = 0
183 ENDIF
184 IF (ismstr==10) THEN
185 npt = 4
186 CALL s10volnodt3(
187 1 elbuf_tab(ng),varnod6, x, nc,
188 2 gbuf%OFF, gbuf%SMSTR, xdp, nel,
189 3 npt)
190 ibid = 1
191 DO ip=1,npt
192 lbuf => elbuf_tab(ng)%BUFLY(ibid)%LBUF(ip,ibid,ibid)
193 DO i=lft,llt
194 IF(gbuf%OFF(i) == zero) THEN
195 vol0(i)=zero
196 ELSE
197 vol0(i)=lbuf%VOL(i)
198 ENDIF
199 ENDDO
200 !Parith-On treatment
201 CALL foat_to_6_float(lft ,llt ,vol0 ,vol06 )
202 DO i=lft,llt
203 i1 = nc(i,ip) +numnod
204 varnod6(1:6,i1) = varnod6(1:6,i1) + vol06(1:6,i)
205 ENDDO
206 END DO !IP=1,NPT
207 ELSE
208 CALL s10volnod3(
209 1 varnod6, x, nc, gbuf%OFF,
210 2 volg , xdp, nel, npt,
211 3 ismstr)
212 DO i=lft,llt
213 IF(gbuf%OFF(i) == zero) THEN
214 vol0(i)=zero
215 ELSE
216 vol0(i)=gbuf%VOL(i)
217 ENDIF
218 ENDDO
219 !Parith-On treatment
220 CALL foat_to_6_float(lft ,llt ,vol0 ,vol06 )
221 DO i=lft,llt
222 i1=nc1(i)+numnod
223 i2=nc2(i)+numnod
224 i3=nc3(i)+numnod
225 i4=nc4(i)+numnod
226 !Parith-On treatment
227 DO k=1,6
228 varnod6(k,i1) = varnod6(k,i1) + vol06(k,i)
229 varnod6(k,i2) = varnod6(k,i2) + vol06(k,i)
230 varnod6(k,i3) = varnod6(k,i3) + vol06(k,i)
231 varnod6(k,i4) = varnod6(k,i4) + vol06(k,i)
232 ENDDO
233 ENDDO
234 END IF
235 ENDIF !ISROT=3
236
237 ENDDO !DO=1,NG
238
239c SPMD EXCHANGE
240 IF(nspmd > 1)THEN
241 lenr = 2*(iad_elem(1,nspmd+1)-iad_elem(1,1))
242 CALL spmd_exch_vol(varnod6(1,1),varnod6(1,numnod+1),iad_elem,fr_elem,lenr )
243 ENDIF
244
245C PARITH/ON assembly
246 DO i=1,numnod
247
248 j=i+numnod
249 DO k=1,6
250 !VOLNOD
251 sfem_nodvar(i) = sfem_nodvar(i) + varnod6(k,i)
252 !SFEM_NODVAR
253 sfem_nodvar(j) = sfem_nodvar(j) + varnod6(k,j)
254 ENDDO
255
256 !MODIFY RELATIVE VOLUME
257 IF(sfem_nodvar(j) /= 0)THEN
258 sfem_nodvar(i)=sfem_nodvar(i)/sfem_nodvar(j)
259 ENDIF
260 ENDDO
261
262C-----------------------------------------------
263 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:226
s10volnod3
subroutine s10volnod3(volnod6, x, nc, offg, volg, xdp, nel, npt, ismstr)
Definition s10volnod3.F:35
s10volnodt3
subroutine s10volnodt3(elbuf_tab, volnod6, x, nc, offg, sav, xdp, nel, npt)
Definition s10volnodt3.F:39
s4volnod3
subroutine s4volnod3(volnod6, x, nc1, nc2, nc3, nc4, offg, xdp, nel, ismstr)
Definition s4volnod3.F:35
s4volnod_sm
subroutine s4volnod_sm(volnod6, v, nc1, nc2, nc3, nc4, vol0, amu, offg, sav, nel, ismstr)
Definition s4volnod_sm.F:34
spmd_exch_vol
subroutine spmd_exch_vol(volnod6, varnod6, iad_elem, fr_elem, lenr)
Definition spmd_exch_vol.F:35