OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cupdtn3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"
#include "comlock.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cupdtn3 (jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixc, pm, area, thk, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, eint, partsav, mat, ipartc, fac, jthe, them, fthe, condn, conde, nodadt_therm)
subroutine cupdtn3p (jft, jlt, offg, off, sti, stir, fsky, fskyv, iadc, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, ixc, eint, partsav, mat, ipartc, pm, area, thk, fac, jthe, them, fthesky, condnsky, conde, nodadt_therm)

Function/Subroutine Documentation

◆ cupdtn3()

subroutine cupdtn3 ( integer jft,
integer jlt,
f,
m,
integer nvc,
offg,
off,
sti,
stir,
stifn,
stifr,
integer, dimension(nixc,mvsiz) ixc,
pm,
area,
thk,
f11,
f12,
f13,
f14,
f21,
f22,
f23,
f24,
f31,
f32,
f33,
f34,
m11,
m12,
m13,
m14,
m21,
m22,
m23,
m24,
m31,
m32,
m33,
m34,
eint,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) ipartc,
fac,
integer jthe,
them,
fthe,
condn,
conde,
integer, intent(in) nodadt_therm )

Definition at line 31 of file cupdtn3.F.

41 use element_mod , only : nixc
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "scr18_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER ,INTENT(IN) :: NODADT_THERM
59 INTEGER JFT, JLT, NVC,JTHE
60 INTEGER IXC(NIXC,MVSIZ),MAT(MVSIZ),IPARTC(*)
61C REAL
62 my_real
63 . f(3,*), m(3,*), offg(*), off(*), sti(*), stir(*),
64 . stifn(*), stifr(*),pm(npropm,*),
65 . f11(mvsiz), f12(mvsiz), f13(mvsiz), f14(mvsiz),
66 . f21(mvsiz), f22(mvsiz), f23(mvsiz), f24(mvsiz),
67 . f31(mvsiz), f32(mvsiz), f33(mvsiz), f34(mvsiz),
68 . m11(mvsiz), m12(mvsiz), m13(mvsiz), m14(mvsiz),
69 . m21(mvsiz), m22(mvsiz), m23(mvsiz), m24(mvsiz),
70 . m31(mvsiz), m32(mvsiz), m33(mvsiz), m34(mvsiz),
71 . eint(jlt,2),partsav(npsav,*),area(*) ,thk(*),fac(mvsiz,2),
72 . them(mvsiz,4) ,fthe(*),condn(*),conde(*)
73CMasParINCLUDE 'cupdt3.intmap.inc'
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER NVC1, NVC2, NVC3, NVC4, I
78 my_real
79 . off_l
80C-----------------------------------------------
81C
82C cumulative energy of deleted elements at the moment of deletion
83
84 off_l = zero
85 DO i=jft,jlt
86 IF(off(i)<one)offg(i) = off(i)
87 off_l = min(off_l,offg(i))
88 ENDDO
89 IF(off_l<zero)THEN
90 DO i=jft,jlt
91 IF(offg(i)<zero)THEN
92 f11(i)=zero
93 f21(i)=zero
94 f31(i)=zero
95 m11(i)=zero
96 m21(i)=zero
97 m31(i)=zero
98 f12(i)=zero
99 f22(i)=zero
100 f32(i)=zero
101 m12(i)=zero
102 m22(i)=zero
103 m32(i)=zero
104 f13(i)=zero
105 f23(i)=zero
106 f33(i)=zero
107 m13(i)=zero
108 m23(i)=zero
109 m33(i)=zero
110 f14(i)=zero
111 f24(i)=zero
112 f34(i)=zero
113 m14(i)=zero
114 m24(i)=zero
115 m34(i)=zero
116 sti(i)=zero
117 stir(i)=zero
118 conde(i)=zero
119 ENDIF
120 ENDDO
121 ENDIF
122C 140---
123C
124 nvc1= nvc/8
125 nvc2=(nvc-nvc1*8)/4
126 nvc3=(nvc-nvc1*8-nvc2*4)/2
127 nvc4=(nvc-nvc1*8-nvc2*4-nvc3*2)
128C
129 IF(nvc1==0)THEN
130 IF(jthe == 0 ) THEN
131#include "vectorize.inc"
132 DO i=jft,jlt
133 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
134 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
135 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
136 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
137 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
138 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
139 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)*fac(i,1)
140 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)*fac(i,1)
141 ENDDO
142 ELSE
143 IF(nodadt_therm == 1 ) THEN
144#include "vectorize.inc"
145 DO i=jft,jlt
146 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
147 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
148 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
149 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
150 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
151 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
152 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)*fac(i,1)
153 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)*fac(i,1)
154 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
155 condn(ixc(2,i))=condn(ixc(2,i))+conde(i)
156 ENDDO
157 ELSE
158#include "vectorize.inc"
159 DO i=jft,jlt
160 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
161 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
162 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
163 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
164 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
165 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
166 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)*fac(i,1)
167 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)*fac(i,1)
168 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
169 ENDDO
170 ENDIF
171 ENDIF
172
173 ELSE
174C
175 IF(jthe == 0 ) THEN
176 DO i=jft,jlt
177 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
178 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
179 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
180 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
181 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
182 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
183 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)*fac(i,1)
184 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)*fac(i,1)
185 ENDDO
186 ELSE
187 IF(nodadt_therm == 1 ) THEN
188 DO i=jft,jlt
189 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
190 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
191 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
192 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
193 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
194 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
195 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)*fac(i,1)
196 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)*fac(i,1)
197 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
198 condn(ixc(2,i))=condn(ixc(2,i))+conde(i)
199 ENDDO
200 ELSE
201 DO i=jft,jlt
202 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
203 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
204 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
205 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
206 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
207 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
208 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)*fac(i,1)
209 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)*fac(i,1)
210 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
211 ENDDO
212 ENDIF
213 ENDIF
214 ENDIF
215C
216 IF(nvc2==0)THEN
217 IF(jthe == 0 ) THEN
218#include "vectorize.inc"
219 DO i=jft,jlt
220 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
221 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
222 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
223 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
224 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
225 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
226 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)*fac(i,2)
227 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)*fac(i,2)
228 ENDDO
229 ELSE
230 IF(nodadt_therm == 1 ) THEN
231#include "vectorize.inc"
232 DO i=jft,jlt
233 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
234 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
235 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
236 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
237 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
238 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
239 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)*fac(i,2)
240 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)*fac(i,2)
241 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
242 condn(ixc(3,i))=condn(ixc(3,i))+conde(i)
243 ENDDO
244 ELSE
245#include "vectorize.inc"
246 DO i=jft,jlt
247 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
248 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
249 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
250 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
251 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
252 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
253 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)*fac(i,2)
254 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)*fac(i,2)
255 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
256 ENDDO
257 ENDIF
258 ENDIF
259C
260 ELSE
261 IF(jthe == 0 ) THEN
262 DO i=jft,jlt
263 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
264 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
265 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
266 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
267 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
268 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
269 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)*fac(i,2)
270 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)*fac(i,2)
271 ENDDO
272 ELSE
273 IF(nodadt_therm == 1 ) THEN
274 DO i=jft,jlt
275 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
276 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
277 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
278 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
279 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
280 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
281 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)*fac(i,2)
282 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)*fac(i,2)
283 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
284 condn(ixc(3,i))=condn(ixc(3,i))+conde(i)
285 ENDDO
286 ELSE
287 DO i=jft,jlt
288 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
289 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
290 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
291 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
292 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
293 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
294 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)*fac(i,2)
295 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)*fac(i,2)
296 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
297 ENDDO
298 ENDIF
299 ENDIF
300C
301 ENDIF
302C
303 IF(nvc3==0)THEN
304 IF(jthe == 0) THEN
305#include "vectorize.inc"
306 DO i=jft,jlt
307 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
308 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
309 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
310 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
311 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
312 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
313 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)*fac(i,1)
314 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)*fac(i,1)
315 ENDDO
316 ELSE
317 IF(nodadt_therm == 1 ) THEN
318#include "vectorize.inc"
319 DO i=jft,jlt
320 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
321 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
322 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
323 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
324 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
325 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
326 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)*fac(i,1)
327 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)*fac(i,1)
328 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
329 condn(ixc(4,i))=condn(ixc(4,i))+conde(i)
330 ENDDO
331 ELSE
332#include "vectorize.inc"
333 DO i=jft,jlt
334 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
335 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
336 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
337 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
338 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
339 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
340 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)*fac(i,1)
341 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)*fac(i,1)
342 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
343 ENDDO
344 ENDIF
345 ENDIF
346C
347 ELSE
348 IF(jthe == 0 ) THEN
349 DO i=jft,jlt
350 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
351 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
352 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
353 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
354 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
355 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
356 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)*fac(i,1)
357 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)*fac(i,1)
358 ENDDO
359 ELSE
360 IF(nodadt_therm == 1 ) THEN
361 DO i=jft,jlt
362 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
363 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
364 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
365 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
366 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
367 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
368 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)*fac(i,1)
369 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)*fac(i,1)
370 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
371 condn(ixc(4,i))=condn(ixc(4,i))+conde(i)
372 ENDDO
373 ELSE
374 DO i=jft,jlt
375 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
376 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
377 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
378 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
379 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
380 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
381 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)*fac(i,1)
382 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)*fac(i,1)
383 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
384 ENDDO
385 ENDIF
386 ENDIF
387C
388 ENDIF
389C
390 IF(nvc4==0)THEN
391 IF(jthe == 0) THEN
392#include "vectorize.inc"
393 DO i=jft,jlt
394 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
395 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
396 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
397 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
398 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
399 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
400 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)*fac(i,2)
401 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)*fac(i,2)
402 ENDDO
403 ELSE
404 IF(nodadt_therm == 1 ) THEN
405#include "vectorize.inc"
406 DO i=jft,jlt
407 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
408 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
409 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
410 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
411 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
412 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
413 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)*fac(i,2)
414 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)*fac(i,2)
415 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
416 condn(ixc(5,i))=condn(ixc(5,i))+conde(i)
417 ENDDO
418 ELSE
419#include "vectorize.inc"
420 DO i=jft,jlt
421 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
422 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
423 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
424 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
425 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
426 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
427 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)*fac(i,2)
428 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)*fac(i,2)
429 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
430 ENDDO
431 ENDIF
432
433 ENDIF
434C
435 ELSE
436 IF(jthe == 0) THEN
437 DO i=jft,jlt
438 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
439 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
440 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
441 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
442 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
443 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
444 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)*fac(i,2)
445 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)*fac(i,2)
446 ENDDO
447 ELSE
448 IF(nodadt_therm == 1 ) THEN
449 DO i=jft,jlt
450 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
451 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
452 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
453 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
454 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
455 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
456 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)*fac(i,2)
457 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)*fac(i,2)
458 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
459 condn(ixc(5,i))=condn(ixc(5,i))+conde(i)
460 ENDDO
461 ELSE
462 DO i=jft,jlt
463 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
464 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
465 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
466 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
467 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
468 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
469 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)*fac(i,2)
470 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)*fac(i,2)
471 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
472 ENDDO
473 ENDIF
474 ENDIF
475C
476 ENDIF
477C
478 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20

◆ cupdtn3p()

subroutine cupdtn3p ( integer jft,
integer jlt,
offg,
off,
sti,
stir,
fsky,
fskyv,
integer, dimension(4,*) iadc,
f11,
f12,
f13,
f14,
f21,
f22,
f23,
f24,
f31,
f32,
f33,
f34,
m11,
m12,
m13,
m14,
m21,
m22,
m23,
m24,
m31,
m32,
m33,
m34,
integer, dimension(nixc,mvsiz) ixc,
eint,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) ipartc,
pm,
area,
thk,
fac,
integer jthe,
them,
fthesky,
condnsky,
conde,
integer, intent(in) nodadt_therm )

Definition at line 488 of file cupdtn3.F.

498 use element_mod , only : nixc
499C-----------------------------------------------
500C I m p l i c i t T y p e s
501C-----------------------------------------------
502#include "implicit_f.inc"
503#include "comlock.inc"
504C-----------------------------------------------
505C G l o b a l P a r a m e t e r s
506C-----------------------------------------------
507#include "mvsiz_p.inc"
508C-----------------------------------------------
509C C o m m o n B l o c k s
510C-----------------------------------------------
511#include "param_c.inc"
512#include "parit_c.inc"
513#include "scr18_c.inc"
514C-----------------------------------------------
515C D u m m y A r g u m e n t s
516C-----------------------------------------------
517 INTEGER ,INTENT(IN) :: NODADT_THERM
518 INTEGER JFT, JLT, IADC(4,*), JTHE
519 INTEGER IXC(NIXC,MVSIZ),MAT(MVSIZ),IPARTC(*)
520C REAL
521 my_real
522 . offg(*), off(*), sti(*), stir(*),pm(npropm,*),
523 . fskyv(lsky,8), fsky(8,lsky)
524 my_real
525 . f11(mvsiz), f12(mvsiz), f13(mvsiz), f14(mvsiz),
526 . f21(mvsiz), f22(mvsiz), f23(mvsiz), f24(mvsiz),
527 . f31(mvsiz), f32(mvsiz), f33(mvsiz), f34(mvsiz),
528 . m11(mvsiz), m12(mvsiz), m13(mvsiz), m14(mvsiz),
529 . m21(mvsiz), m22(mvsiz), m23(mvsiz), m24(mvsiz),
530 . m31(mvsiz), m32(mvsiz), m33(mvsiz), m34(mvsiz),
531 . conde(mvsiz),
532 . eint(jlt,2),partsav(npsav,*), area(*) ,thk(*),fac(mvsiz,2),
533 . them(mvsiz,4), fthesky(lsky),condnsky(*)
534C-----------------------------------------------
535C L o c a l V a r i a b l e s
536C-----------------------------------------------
537C ds 41i 001 13/16/00 +1
538C INTEGER I, II, K
539 INTEGER I, K
540 my_real
541 . off_l
542C-----------------------------------------------
543C cumulative energy of deleted elements at the moment of deletion
544 off_l = zero
545 DO i=jft,jlt
546 IF(off(i)<one)offg(i) = off(i)
547 off_l = min(off_l,offg(i))
548 ENDDO
549 IF(off_l<zero)THEN
550 DO i=jft,jlt
551 IF(offg(i)<zero)THEN
552 f11(i)=zero
553 f21(i)=zero
554 f31(i)=zero
555 m11(i)=zero
556 m21(i)=zero
557 m31(i)=zero
558 f12(i)=zero
559 f22(i)=zero
560 f32(i)=zero
561 m12(i)=zero
562 m22(i)=zero
563 m32(i)=zero
564 f13(i)=zero
565 f23(i)=zero
566 f33(i)=zero
567 m13(i)=zero
568 m23(i)=zero
569 m33(i)=zero
570 f14(i)=zero
571 f24(i)=zero
572 f34(i)=zero
573 m14(i)=zero
574 m24(i)=zero
575 m34(i)=zero
576 sti(i)=zero
577 stir(i)=zero
578 conde(i)=zero
579 ENDIF
580 ENDDO
581 ENDIF
582
583 IF (ivector==1) THEN
584#include "vectorize.inc"
585 DO i=jft,jlt
586 fskyv(iadc(1,i),1)=-f11(i)
587 fskyv(iadc(1,i),2)=-f21(i)
588 fskyv(iadc(1,i),3)=-f31(i)
589 fskyv(iadc(1,i),4)=-m11(i)
590 fskyv(iadc(1,i),5)=-m21(i)
591 fskyv(iadc(1,i),6)=-m31(i)
592 fskyv(iadc(1,i),7)=sti(i)*fac(i,1)
593 fskyv(iadc(1,i),8)=stir(i)*fac(i,1)
594C
595 fskyv(iadc(2,i),1)=-f12(i)
596 fskyv(iadc(2,i),2)=-f22(i)
597 fskyv(iadc(2,i),3)=-f32(i)
598 fskyv(iadc(2,i),4)=-m12(i)
599 fskyv(iadc(2,i),5)=-m22(i)
600 fskyv(iadc(2,i),6)=-m32(i)
601 fskyv(iadc(2,i),7)=sti(i)*fac(i,2)
602 fskyv(iadc(2,i),8)=stir(i)*fac(i,2)
603C
604 fskyv(iadc(3,i),1)=-f13(i)
605 fskyv(iadc(3,i),2)=-f23(i)
606 fskyv(iadc(3,i),3)=-f33(i)
607 fskyv(iadc(3,i),4)=-m13(i)
608 fskyv(iadc(3,i),5)=-m23(i)
609 fskyv(iadc(3,i),6)=-m33(i)
610 fskyv(iadc(3,i),7)=sti(i)*fac(i,1)
611 fskyv(iadc(3,i),8)=stir(i)*fac(i,1)
612C
613 fskyv(iadc(4,i),1)=-f14(i)
614 fskyv(iadc(4,i),2)=-f24(i)
615 fskyv(iadc(4,i),3)=-f34(i)
616 fskyv(iadc(4,i),4)=-m14(i)
617 fskyv(iadc(4,i),5)=-m24(i)
618 fskyv(iadc(4,i),6)=-m34(i)
619 fskyv(iadc(4,i),7)=sti(i)*fac(i,2)
620 fskyv(iadc(4,i),8)=stir(i)*fac(i,2)
621 ENDDO
622C
623 IF(jthe > 0 ) THEN
624#include "vectorize.inc"
625 DO i=jft,jlt
626 fthesky(iadc(1,i)) = them(i,1)
627 fthesky(iadc(2,i)) = them(i,2)
628 fthesky(iadc(3,i)) = them(i,3)
629 fthesky(iadc(4,i)) = them(i,4)
630 ENDDO
631 IF(nodadt_therm ==1) THEN
632#include "vectorize.inc"
633 DO i=jft,jlt
634 condnsky(iadc(1,i)) = conde(i)
635 condnsky(iadc(2,i)) = conde(i)
636 condnsky(iadc(3,i)) = conde(i)
637 condnsky(iadc(4,i)) = conde(i)
638 ENDDO
639 ENDIF
640 ENDIF
641C
642 ELSE
643 DO i=jft,jlt
644C
645C Prefetch test for HP
646C
647C$DIR PREFETCH IADC(1,I+12)
648C$DIR PREFETCH FSKY(1,IADC(1,I+4))
649C$DIR PREFETCH FSKY(8,IADC(1,I+4))
650C$DIR PREFETCH FSKY(1,IADC(2,I+4))
651C$DIR PREFETCH FSKY(8,IADC(2,I+4))
652C$DIR PREFETCH FSKY(1,IADC(3,I+4))
653C$DIR PREFETCH FSKY(8,IADC(3,I+4))
654C$DIR PREFETCH FSKY(1,IADC(4,I+4))
655C$DIR PREFETCH FSKY(8,IADC(4,I+4))
656C
657C End of Prefetch
658C
659 k = iadc(1,i)
660 fsky(1,k)=-f11(i)
661 fsky(2,k)=-f21(i)
662 fsky(3,k)=-f31(i)
663 fsky(4,k)=-m11(i)
664 fsky(5,k)=-m21(i)
665 fsky(6,k)=-m31(i)
666 fsky(7,k)=sti(i)*fac(i,1)
667 fsky(8,k)=stir(i)*fac(i,1)
668C
669 k = iadc(2,i)
670 fsky(1,k)=-f12(i)
671 fsky(2,k)=-f22(i)
672 fsky(3,k)=-f32(i)
673 fsky(4,k)=-m12(i)
674 fsky(5,k)=-m22(i)
675 fsky(6,k)=-m32(i)
676 fsky(7,k)=sti(i)*fac(i,2)
677 fsky(8,k)=stir(i)*fac(i,2)
678C
679 k = iadc(3,i)
680 fsky(1,k)=-f13(i)
681 fsky(2,k)=-f23(i)
682 fsky(3,k)=-f33(i)
683 fsky(4,k)=-m13(i)
684 fsky(5,k)=-m23(i)
685 fsky(6,k)=-m33(i)
686 fsky(7,k)=sti(i)*fac(i,1)
687 fsky(8,k)=stir(i)*fac(i,1)
688C
689 k = iadc(4,i)
690 fsky(1,k)=-f14(i)
691 fsky(2,k)=-f24(i)
692 fsky(3,k)=-f34(i)
693 fsky(4,k)=-m14(i)
694 fsky(5,k)=-m24(i)
695 fsky(6,k)=-m34(i)
696 fsky(7,k)=sti(i)*fac(i,2)
697 fsky(8,k)=stir(i)*fac(i,2)
698 ENDDO
699C
700 IF(jthe > 0 ) THEN
701 DO i=jft,jlt
702 fthesky(iadc(1,i)) = them(i,1)
703 fthesky(iadc(2,i)) = them(i,2)
704 fthesky(iadc(3,i)) = them(i,3)
705 fthesky(iadc(4,i)) = them(i,4)
706 ENDDO
707 IF(nodadt_therm ==1) THEN
708 DO i=jft,jlt
709 condnsky(iadc(1,i)) = conde(i)*fac(i,1)
710 condnsky(iadc(2,i)) = conde(i)*fac(i,2)
711 condnsky(iadc(3,i)) = conde(i)*fac(i,1)
712 condnsky(iadc(4,i)) = conde(i)*fac(i,2)
713 ENDDO
714 ENDIF
715 ENDIF
716C
717 ENDIF
718C
719 RETURN