OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4cumu3p.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!|| s4cumu3p ../engine/source/elements/solid/solide4/s4cumu3p.F
25!||--- called by ------------------------------------------------------
26!|| multi_fvm2fem ../engine/source/multifluid/multi_fvm2fem.F
27!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
28!||====================================================================
29 SUBROUTINE s4cumu3p(
30 1 OFFG, STI, FSKY, FSKYV,
31 2 IADS, F11, F21, F31,
32 3 F12, F22, F32, F13,
33 4 F23, F33, F14, F24,
34 5 F34, THEM, FTHESKY, CONDNSKY,
35 6 CONDE, NEL, NFT, JTHE ,
36 7 NODADT_THERM)
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "parit_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 my_real
58 . OFFG(*),FSKYV(LSKY,8),FSKY(8,LSKY),STI(*),
59 . F11(*),F21(*),F31(*),F12(*),F22(*),F32(*),
60 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
61 . them(mvsiz,4),fthesky(*),condnsky(*),conde(*)
62 INTEGER IADS(8,*)
63CMasParINCLUDE 'scumu3.intmap.inc'
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I, II, K,J
68 my_real
69 . off_l
70C-----------------------------------------------
71 off_l = 0.
72 DO i=1,nel
73Cf small3b IF(OFF(I)<1.)OFFG(I) = OFF(I)
74 off_l = min(off_l,offg(i))
75 ENDDO
76 IF(off_l<zero)THEN
77 DO i=1,nel
78 IF(offg(i)<zero)THEN
79 f11(i)=zero
80 f21(i)=zero
81 f31(i)=zero
82 f12(i)=zero
83 f22(i)=zero
84 f32(i)=zero
85 f13(i)=zero
86 f23(i)=zero
87 f33(i)=zero
88 f14(i)=zero
89 f24(i)=zero
90 f34(i)=zero
91 sti(i)=zero
92 ENDIF
93 ENDDO
94 ENDIF
95 IF(jthe < 0 ) THEN
96 IF(off_l<=zero)THEN
97 DO j=1,4
98 DO i=1,nel
99 IF(offg(i)<=zero)THEN
100 them(i,j)=zero
101 ENDIF
102 ENDDO
103 ENDDO
104 ENDIF
105 IF(nodadt_therm == 1) THEN
106 IF(off_l<zero)THEN
107 DO i=1,nel
108 IF(offg(i)<zero)THEN
109 conde(i)=zero
110 ENDIF
111 ENDDO
112 ENDIF
113 ENDIF
114 ENDIF
115C
116C because 2*Mnodal = 2*Melement/4
117 DO i=1,nel
118 sti(i)=half*sti(i)
119 END DO
120 IF(nodadt_therm == 1 ) THEN
121 DO i=1,nel
122 conde(i)=fourth*conde(i)
123 END DO
124 ENDIF
125C
126 IF(ivector==1) THEN
127#include "vectorize.inc"
128 DO i=1,nel
129 ii=i+nft
130 k = iads(1,ii)
131 fskyv(k,1)=f11(i)
132 fskyv(k,2)=f21(i)
133 fskyv(k,3)=f31(i)
134 fskyv(k,4)=zero
135 fskyv(k,5)=zero
136 fskyv(k,6)=zero
137 fskyv(k,7)=sti(i)
138C
139 k = iads(3,ii)
140 fskyv(k,1)=f12(i)
141 fskyv(k,2)=f22(i)
142 fskyv(k,3)=f32(i)
143 fskyv(k,4)=zero
144 fskyv(k,5)=zero
145 fskyv(k,6)=zero
146 fskyv(k,7)=sti(i)
147C
148 k = iads(6,ii)
149 fskyv(k,1)=f13(i)
150 fskyv(k,2)=f23(i)
151 fskyv(k,3)=f33(i)
152 fskyv(k,4)=zero
153 fskyv(k,5)=zero
154 fskyv(k,6)=zero
155 fskyv(k,7)=sti(i)
156C
157 k = iads(5,ii)
158 fskyv(k,1)=f14(i)
159 fskyv(k,2)=f24(i)
160 fskyv(k,3)=f34(i)
161 fskyv(k,4)=zero
162 fskyv(k,5)=zero
163 fskyv(k,6)=zero
164 fskyv(k,7)=sti(i)
165C
166 ENDDO
167 ELSE
168 DO i=1,nel
169 ii=i+nft
170 k = iads(1,ii)
171 fsky(1,k)=f11(i)
172 fsky(2,k)=f21(i)
173 fsky(3,k)=f31(i)
174 fsky(7,k)=sti(i)
175C
176 k = iads(3,ii)
177 fsky(1,k)=f12(i)
178 fsky(2,k)=f22(i)
179 fsky(3,k)=f32(i)
180 fsky(7,k)=sti(i)
181C
182 k = iads(6,ii)
183 fsky(1,k)=f13(i)
184 fsky(2,k)=f23(i)
185 fsky(3,k)=f33(i)
186 fsky(7,k)=sti(i)
187C
188 k = iads(5,ii)
189 fsky(1,k)=f14(i)
190 fsky(2,k)=f24(i)
191 fsky(3,k)=f34(i)
192 fsky(7,k)=sti(i)
193C
194 ENDDO
195 ENDIF
196C
197 IF(jthe < 0) THEN
198 DO i=1,nel
199 ii=i+nft
200 k = iads(1,ii)
201 fthesky(k)=them(i,1)
202C
203 k = iads(3,ii)
204 fthesky(k)=them(i,2)
205C
206 k = iads(6,ii)
207 fthesky(k)=them(i,3)
208C
209 k = iads(5,ii)
210 fthesky(k)=them(i,4)
211C
212 ENDDO
213 IF(nodadt_therm == 1 ) THEN
214 DO i=1,nel
215 ii=i+nft
216 k = iads(1,ii)
217 condnsky(k)=conde(i)
218C
219 k = iads(3,ii)
220 condnsky(k)=conde(i)
221C
222 k = iads(6,ii)
223 condnsky(k)=conde(i)
224C
225 k = iads(5,ii)
226 condnsky(k)=conde(i)
227C
228 ENDDO
229 ENDIF
230 ENDIF
231C
232 RETURN
233 END
min
#define min(a, b)
Definition macros.h:20
s4cumu3p
subroutine s4cumu3p(offg, sti, fsky, fskyv, iads, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, them, fthesky, condnsky, conde, nel, nft, jthe, nodadt_therm)
Definition s4cumu3p.F:37