OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s20cumu3p.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!|| s20cumu3p ../engine/source/elements/solid/solide20/s20cumu3p.F
25!||--- called by ------------------------------------------------------
26!|| s16forc3 ../engine/source/elements/thickshell/solide16/s16forc3.F
27!|| s20forc3 ../engine/source/elements/solid/solide20/s20forc3.F
28!||====================================================================
29 SUBROUTINE s20cumu3p(
30 1 OFFG, STIG, FSKY, FSKYV,
31 2 IADS, FX, FY, FZ,
32 3 IADSP, NC, IPERM1, IPERM2,
33 4 NPE, THEM, FTHESKY, CONDNSKY,
34 5 CONDEG, NEL, NFT, JTHE ,
35 6 NODADT_THERM)
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "parit_c.inc"
48#include "com04_c.inc"
49#include "scr18_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER, INTENT(IN) :: NEL
54 INTEGER, INTENT(IN) :: NFT
55 INTEGER, INTENT(IN) :: JTHE
56 INTEGER, INTENT(IN) :: NODADT_THERM
57 INTEGER NPE
58 INTEGER IADS(8,*),IADSP(NPE-8,*),NC(MVSIZ,NPE),
59 . iperm1(npe),iperm2(npe)
60C REAL
61 my_real
62 . offg(*),fskyv(lsky,8),fsky(8,lsky),stig(mvsiz,npe),
63 . fx(mvsiz,npe), fy(mvsiz,npe), fz(mvsiz,npe),them(mvsiz,npe),
64 . fthesky(*),condnsky(*),condeg(mvsiz,npe)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, II, K,N,J
69 INTEGER N1,N2,NN
70C-----------------------------------------------
71 my_real
72 . OFF_L
73C-----------------------------------------------
74 off_l = 0.
75 DO i=1,nel
76Cf small3b IF(OFF(I)<1.)OFFG(I) = OFF(I)
77 off_l = min(off_l,offg(i))
78 ENDDO
79 IF(off_l<zero)THEN
80 DO n=1,npe
81 DO i=1,nel
82 IF(offg(i)<zero)THEN
83 fx(i,n)=zero
84 fy(i,n)=zero
85 fz(i,n)=zero
86 stig(i,n)=zero
87 ENDIF
88 ENDDO
89 ENDDO
90 ENDIF
91
92 IF(jthe < 0 ) THEN
93 IF(off_l<=zero)THEN
94 DO j=1,npe
95 DO i=1,nel
96 IF(offg(i)<=zero)THEN
97 them(i,j)=zero
98 ENDIF
99 ENDDO
100 ENDDO
101 ENDIF
102 IF(nodadt_therm == 1) THEN
103 IF(off_l<zero)THEN
104 DO j=1,npe
105 DO i=1,nel
106 IF(offg(i)<zero)THEN
107 condeg(i,j)=zero
108 ENDIF
109 ENDDO
110 ENDDO
111 ENDIF
112 ENDIF
113 ENDIF
114
115 IF(ivector==1) THEN
116 DO n= 1,8
117#include "vectorize.inc"
118 DO i=1,nel
119C II=I+NFT
120 k = iads(n,i)
121 fskyv(k,1)=fx(i,n)
122 fskyv(k,2)=fy(i,n)
123 fskyv(k,3)=fz(i,n)
124 fskyv(k,7)=stig(i,n)
125 ENDDO
126 ENDDO
127 DO n= 1,npe-8
128 n1=iperm1(n+8)
129 n2=iperm2(n+8)
130 DO i=1,nel
131C II=I+NFT-NUMELS+NUMELS20
132 nn = nc(i,n+8)
133 IF(nn/=0)THEN
134 k = iadsp(n,i)
135 fskyv(k,1)=fx(i,n+8)
136 fskyv(k,2)=fy(i,n+8)
137 fskyv(k,3)=fz(i,n+8)
138 fskyv(k,7)=stig(i,n+8)
139 ELSE
140 k = iads(n1,i)
141 fskyv(k,1)=fskyv(k,1)+half*fx(i,n+8)
142 fskyv(k,2)=fskyv(k,2)+half*fy(i,n+8)
143 fskyv(k,3)=fskyv(k,3)+half*fz(i,n+8)
144 fskyv(k,7)=fskyv(k,7)+half*stig(i,n+8)
145 k = iads(n2,i)
146 fskyv(k,1)=fskyv(k,1)+half*fx(i,n+8)
147 fskyv(k,2)=fskyv(k,2)+half*fy(i,n+8)
148 fskyv(k,3)=fskyv(k,3)+half*fz(i,n+8)
149 fskyv(k,7)=fskyv(k,7)+half*stig(i,n+8)
150 ENDIF
151 ENDDO
152 ENDDO
153 ELSE
154 DO n= 1,8
155 DO i=1,nel
156 k = iads(n,i)
157 fsky(1,k)=fx(i,n)
158 fsky(2,k)=fy(i,n)
159 fsky(3,k)=fz(i,n)
160 fsky(7,k)=stig(i,n)
161 ENDDO
162 ENDDO
163 DO n= 1,npe-8
164 n1=iperm1(n+8)
165 n2=iperm2(n+8)
166 DO i=1,nel
167C II=I+NFT-NUMELS+NUMELS20
168 nn = nc(i,n+8)
169 IF(nn/=0)THEN
170 k = iadsp(n,i)
171 fsky(1,k)=fx(i,n+8)
172 fsky(2,k)=fy(i,n+8)
173 fsky(3,k)=fz(i,n+8)
174 fsky(7,k)=stig(i,n+8)
175 ELSE
176 k = iads(n1,i)
177 fsky(1,k)=fsky(1,k)+half*fx(i,n+8)
178 fsky(2,k)=fsky(2,k)+half*fy(i,n+8)
179 fsky(3,k)=fsky(3,k)+half*fz(i,n+8)
180 fsky(7,k)=fsky(7,k)+half*stig(i,n+8)
181 k = iads(n2,i)
182 fsky(1,k)=fsky(1,k)+half*fx(i,n+8)
183 fsky(2,k)=fsky(2,k)+half*fy(i,n+8)
184 fsky(3,k)=fsky(3,k)+half*fz(i,n+8)
185 fsky(7,k)=fsky(7,k)+half*stig(i,n+8)
186 ENDIF
187 ENDDO
188 ENDDO
189 ENDIF
190C
191 IF(jthe < 0 ) THEN
192 DO n= 1,8
193 DO i=1,nel
194 k = iads(n,i)
195 fthesky(k)=them(i,n)
196 ENDDO
197 ENDDO
198 DO n= 1,npe-8
199 n1=iperm1(n+8)
200 n2=iperm2(n+8)
201 DO i=1,nel
202C II=I+NFT-NUMELS+NUMELS20
203 nn = nc(i,n+8)
204 IF(nn/=0)THEN
205 k = iadsp(n,i)
206 fthesky(k)=them(i,n+8)
207 ELSE
208 k = iads(n1,i)
209 fthesky(k)=fthesky(k) + half*them(i,n+8)
210 k = iads(n2,i)
211 fthesky(k)=fthesky(k) + half*them(i,n+8)
212 ENDIF
213 ENDDO
214 ENDDO
215
216 IF(nodadt_therm == 1) THEN
217 DO n= 1,8
218 DO i=1,nel
219 k = iads(n,i)
220 condnsky(k)=condeg(i,n)
221 ENDDO
222 ENDDO
223 DO n= 1,npe-8
224 n1=iperm1(n+8)
225 n2=iperm2(n+8)
226 DO i=1,nel
227C II=I+NFT-NUMELS+NUMELS20
228 nn = nc(i,n+8)
229 IF(nn/=0)THEN
230 k = iadsp(n,i)
231 condnsky(k)=condeg(i,n+8)
232 ELSE
233 k = iads(n1,i)
234 condnsky(k)=condnsky(k) + half*condeg(i,n+8)
235 k = iads(n2,i)
236 condnsky(k)=condnsky(k) + half*condeg(i,n+8)
237 ENDIF
238 ENDDO
239 ENDDO
240 ENDIF
241
242 ENDIF
243 IF(nsect>0)THEN
244 DO n= 1,npe-8
245 n1=iperm1(n+8)
246 n2=iperm2(n+8)
247 DO i=1,nel
248 nn = nc(i,n+8)
249 IF(nn==0)THEN
250 fx(i,n1)=fx(i,n1)+half*fx(i,n+8)
251 fy(i,n1)=fy(i,n1)+half*fy(i,n+8)
252 fz(i,n1)=fz(i,n1)+half*fz(i,n+8)
253 fx(i,n2)=fx(i,n2)+half*fx(i,n+8)
254 fy(i,n2)=fy(i,n2)+half*fy(i,n+8)
255 fz(i,n2)=fz(i,n2)+half*fz(i,n+8)
256 END IF
257 END DO
258 END DO
259 END IF
260C
261 RETURN
262 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
s20cumu3p
subroutine s20cumu3p(offg, stig, fsky, fskyv, iads, fx, fy, fz, iadsp, nc, iperm1, iperm2, npe, them, fthesky, condnsky, condeg, nel, nft, jthe, nodadt_therm)
Definition s20cumu3p.F:36