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"

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 29 of file cupdtn3.F.

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

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