OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4lagsfem.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| s4lagsfem ../engine/source/elements/solid/solide4_sfem/s4lagsfem.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| foat_to_6_float ../engine/source/system/parit.F
29!|| initbuf ../engine/share/resol/initbuf.F
30!|| s10volnod3 ../engine/source/elements/solid/solide4_sfem/s10volnod3.F
31!|| s10volnodt3 ../engine/source/elements/solid/solide4_sfem/s10volnodt3.F
32!|| s4volnod3 ../engine/source/elements/solid/solide4_sfem/s4volnod3.F
33!|| s4volnod_sm ../engine/source/elements/solid/solide4_sfem/s4volnod_sm.F
34!|| spmd_exch_vol ../engine/source/mpi/nodes/spmd_exch_vol.F
35!||--- uses -----------------------------------------------------
36!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
37!|| initbuf_mod ../engine/share/resol/initbuf.F
38!||====================================================================
39 SUBROUTINE s4lagsfem(IPARG,IXS,X,V,ELBUF_TAB,SFEM_NODVAR,S_SFEM_NODVAR,
40 . IAD_ELEM,FR_ELEM,IXS10,XDP,SXDP,
41 . NUMNOD, SFR_ELEM, NSPMD, NUMELS, NUMELS8, NUMELS10, NPARG, NGROUP, IRESP)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE initbuf_mod
46 USE elbufdef_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "vect01_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER,INTENT(IN) :: S_SFEM_NODVAR, SFR_ELEM, SXDP !< size for array declaration
63 INTEGER,INTENT(IN) :: NUMELS, NUMELS8, NUMELS10 !< number of elements
64 INTEGER,INTENT(IN) :: NPARG, NGROUP !< sizes for data structure IPARG
65 INTEGER,INTENT(IN) :: NUMNOD !< number of nodes (/NODE)
66 INTEGER,INTENT(IN) :: IRESP
67 INTEGER,INTENT(IN) :: NSPMD !< number of SPMD domain
68 INTEGER IXS(NIXS,NUMELS),IPARG(NPARG,NGROUP),IAD_ELEM(2,NSPMD+1),FR_ELEM(SFR_ELEM),IXS10(6,NUMELS10)
69 my_real, INTENT(IN) :: x(3*numnod),v(3*numnod)
70 my_real,intent(inout) :: sfem_nodvar(s_sfem_nodvar)
71 DOUBLE PRECISION , DIMENSION(SXDP), INTENT(IN) :: XDP
72 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER NG, I, J, I1, I2, I3, I4, K, LENR,NEL,NNOD,ICPRE,IBID,IP
77 INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),NC4(MVSIZ),NC(MVSIZ,10)
78 my_real vol0(mvsiz),volg(mvsiz)
79
80 DOUBLE PRECISION VOL06(6,MVSIZ), VARNOD6(6,2*NUMNOD)
81
82 TYPE(g_bufel_) ,POINTER :: GBUF
83 TYPE(L_BUFEL_) ,POINTER :: LBUF
84C-----------------------------------------------
85C S o u r c e L i n e s
86C-----------------------------------------------
87 sfem_nodvar(1:2*numnod) = zero
88 varnod6(1:6,1:2*numnod) = zero
89 vol06(1:6,1:mvsiz) = zero
90 vol0(1:mvsiz) = zero
91C---------------------------------------------------
92C COMPUTE NODAL VOLUME FOR ALL TETRAHEDRON
93C---------------------------------------------------
94C SMP loop
95C
96 DO ng = 1,ngroup
97 IF(iparg(8, ng) == 1) cycle
98 nnod = iparg(28,ng)
99 icpre = iparg(10,ng)
100 IF(nnod/=4 .AND. nnod /= 10) cycle
101 CALL initbuf(iparg ,ng ,
102 2 mtn ,llt ,nft ,iad ,ity ,
103 3 npt ,jale ,ismstr ,jeul ,jtur ,
104 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
105 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
106 6 irep ,iint ,igtyp ,israt ,isrot ,
107 7 icsen ,isorth ,isorthg ,ifailure,jsms )
108
109 IF(jeul == 1) cycle
110 IF(jale == 1) cycle
111 IF(nnod == 4 .AND. isrot /= 3) cycle
112 IF(icpre == 0 .AND. (nnod == 10 .OR. (nnod == 4 .AND. isrot == 1))) cycle
113 lft=1
114 nel = llt
115
116 DO i=lft,llt
117 j=i+nft
118 nc1(i)=ixs(2,j)
119 nc2(i)=ixs(4,j)
120 nc3(i)=ixs(7,j)
121 nc4(i)=ixs(6,j)
122 ENDDO
123
124 gbuf => elbuf_tab(ng)%GBUF
125 IF(nnod==4 .AND. isrot == 3) THEN
126 CALL s4volnod3(
127 1 varnod6, x, nc1, nc2,
128 2 nc3, nc4, gbuf%OFF, xdp,
129 3 nel, ismstr)
130 IF(iresp==1)THEN
131 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
132 DO i=lft,llt
133 IF(gbuf%OFF(i) == zero) THEN
134 vol0(i)=zero
135 ELSE
136 vol0(i)=lbuf%VOL0DP(i)
137 ENDIF
138 ENDDO
139 ELSE
140 DO i=lft,llt
141 IF(gbuf%OFF(i) == zero) THEN
142 vol0(i)=zero
143 ELSE
144 vol0(i)=gbuf%VOL(i)
145 ENDIF
146 ENDDO
147 END IF !(IRESP==1)THEN
148C-----for small strain elements
149 CALL s4volnod_sm(
150 1 varnod6, v, nc1, nc2,
151 2 nc3, nc4, vol0, gbuf%AMU,
152 3 gbuf%OFF, gbuf%SMSTR, nel, ismstr)
153 !Parith-On treatment
154 CALL foat_to_6_float(lft ,llt ,vol0 ,vol06 )
155 DO i=lft,llt
156 i1=nc1(i)+numnod
157 i2=nc2(i)+numnod
158 i3=nc3(i)+numnod
159 i4=nc4(i)+numnod
160 !Parith-On treatment
161 DO k=1,6
162 varnod6(k,i1) = varnod6(k,i1) + vol06(k,i)
163 varnod6(k,i2) = varnod6(k,i2) + vol06(k,i)
164 varnod6(k,i3) = varnod6(k,i3) + vol06(k,i)
165 varnod6(k,i4) = varnod6(k,i4) + vol06(k,i)
166 ENDDO
167 ENDDO
168 ELSE
169C-----T10 large strain first
170 nc(lft:llt,1) =nc1(lft:llt)
171 nc(lft:llt,2) =nc2(lft:llt)
172 nc(lft:llt,3) =nc3(lft:llt)
173 nc(lft:llt,4) =nc4(lft:llt)
174 IF(isrot /= 1)THEN
175 DO i=lft,llt
176 j=i+nft-numels8
177 nc(i,5:10) =ixs10(1:6,j)
178 ENDDO
179 ELSE
180 nc(lft:llt,5:10) = 0
181 ENDIF
182 IF (ismstr==10) THEN
183 npt = 4
184 CALL s10volnodt3(
185 1 elbuf_tab(ng),varnod6, x, nc,
186 2 gbuf%OFF, gbuf%SMSTR, xdp, nel,
187 3 npt)
188 ibid = 1
189 DO ip=1,npt
190 lbuf => elbuf_tab(ng)%BUFLY(ibid)%LBUF(ip,ibid,ibid)
191 DO i=lft,llt
192 IF(gbuf%OFF(i) == zero) THEN
193 vol0(i)=zero
194 ELSE
195 vol0(i)=lbuf%VOL(i)
196 ENDIF
197 ENDDO
198 !Parith-On treatment
199 CALL foat_to_6_float(lft ,llt ,vol0 ,vol06 )
200 DO i=lft,llt
201 i1 = nc(i,ip) +numnod
202 varnod6(1:6,i1) = varnod6(1:6,i1) + vol06(1:6,i)
203 ENDDO
204 END DO !IP=1,NPT
205 ELSE
206 CALL s10volnod3(
207 1 varnod6, x, nc, gbuf%OFF,
208 2 volg , xdp, nel, npt,
209 3 ismstr)
210 DO i=lft,llt
211 IF(gbuf%OFF(i) == zero) THEN
212 vol0(i)=zero
213 ELSE
214 vol0(i)=gbuf%VOL(i)
215 ENDIF
216 ENDDO
217 !Parith-On treatment
218 CALL foat_to_6_float(lft ,llt ,vol0 ,vol06 )
219 DO i=lft,llt
220 i1=nc1(i)+numnod
221 i2=nc2(i)+numnod
222 i3=nc3(i)+numnod
223 i4=nc4(i)+numnod
224 !Parith-On treatment
225 DO k=1,6
226 varnod6(k,i1) = varnod6(k,i1) + vol06(k,i)
227 varnod6(k,i2) = varnod6(k,i2) + vol06(k,i)
228 varnod6(k,i3) = varnod6(k,i3) + vol06(k,i)
229 varnod6(k,i4) = varnod6(k,i4) + vol06(k,i)
230 ENDDO
231 ENDDO
232 END IF
233 ENDIF !ISROT=3
234
235 ENDDO !DO=1,NG
236
237c SPMD EXCHANGE
238 IF(nspmd > 1)THEN
239 lenr = 2*(iad_elem(1,nspmd+1)-iad_elem(1,1))
240 CALL spmd_exch_vol(varnod6(1,1),varnod6(1,numnod+1),iad_elem,fr_elem,lenr )
241 ENDIF
242
243C PARITH/ON assembly
244 DO i=1,numnod
245
246 j=i+numnod
247 DO k=1,6
248 !VOLNOD
249 sfem_nodvar(i) = sfem_nodvar(i) + varnod6(k,i)
250 !SFEM_NODVAR
251 sfem_nodvar(j) = sfem_nodvar(j) + varnod6(k,j)
252 ENDDO
253
254 !MODIFY RELATIVE VOLUME
255 IF(sfem_nodvar(j) /= 0)THEN
256 sfem_nodvar(i)=sfem_nodvar(i)/sfem_nodvar(j)
257 ENDIF
258 ENDDO
259
260C-----------------------------------------------
261 RETURN
262 END
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:225
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
s4lagsfem
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)
Definition s4lagsfem.F:42
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