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