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

Go to the source code of this file.

Functions/Subroutines

subroutine c3updt3 (jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixtg, nodadt_therm, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, jthe, them, fthe, eint, pm, area, thk, partsav, mat, iparttg, condn, conde)
subroutine c3updt3p (jft, jlt, offg, off, sti, stir, fsky, fskyv, iadtg, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, jthe, them, fthesky, eint, pm, area, thk, partsav, mat, iparttg, condnsky, conde, nodadt_therm)

Function/Subroutine Documentation

◆ c3updt3()

subroutine c3updt3 ( integer jft,
integer jlt,
f,
m,
integer nvc,
offg,
off,
sti,
stir,
stifn,
stifr,
integer, dimension(nixtg,*) ixtg,
integer, intent(in) nodadt_therm,
f11,
f12,
f13,
f21,
f22,
f23,
f31,
f32,
f33,
m11,
m12,
m13,
m21,
m22,
m23,
m31,
m32,
m33,
integer jthe,
them,
fthe,
eint,
pm,
area,
thk,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) iparttg,
condn,
conde )

Definition at line 31 of file c3updt3.F.

40 use element_mod , only : nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "mvsiz_p.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "param_c.inc"
53#include "scr18_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER ,INTENT(IN) :: NODADT_THERM
58 INTEGER JTHE,JFT, JLT, NVC
59 INTEGER IXTG(NIXTG,*),MAT(MVSIZ),IPARTTG(*)
60 my_real
61 . f(3,*), m(3,*), offg(*), off(*), sti(*), stir(*),
62 . stifn(*), stifr(*),condn(*),conde(*)
63 my_real f11(mvsiz), f12(mvsiz), f13(mvsiz),
64 . f21(mvsiz), f22(mvsiz), f23(mvsiz),
65 . f31(mvsiz), f32(mvsiz), f33(mvsiz),
66 . m11(mvsiz), m12(mvsiz), m13(mvsiz),
67 . m21(mvsiz), m22(mvsiz), m23(mvsiz),
68 . m31(mvsiz), m32(mvsiz), m33(mvsiz),
69 . them(mvsiz,3),fthe(*),eint(jlt,2),pm(npropm,*),area(*),thk(*),
70 . partsav(npsav,*)
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,NVC1,NVC2,NVC3,NC1,NC2,NC3
75 my_real
76 . off_l
77C=======================================================================
78C cumulative energy of deleted elements AT the time of deletion
79 off_l = zero
80 DO i=jft,jlt
81 IF(off(i)<one)offg(i) = off(i)
82 off_l = min(off_l,offg(i))
83 ENDDO
84 IF (off_l < zero)THEN
85 DO i=jft,jlt
86 IF (offg(i) < zero)THEN
87 f11(i)=zero
88 f21(i)=zero
89 f31(i)=zero
90 m11(i)=zero
91 m21(i)=zero
92 m31(i)=zero
93 f12(i)=zero
94 f22(i)=zero
95 f32(i)=zero
96 m12(i)=zero
97 m22(i)=zero
98 m32(i)=zero
99 f13(i)=zero
100 f23(i)=zero
101 f33(i)=zero
102 m13(i)=zero
103 m23(i)=zero
104 m33(i)=zero
105 sti(i)=zero
106 stir(i)=zero
107 them(i,1) = zero
108 them(i,2) = zero
109 them(i,3) = zero
110 conde(i)=zero
111 ENDIF
112 ENDDO
113 ENDIF
114C
115 nvc1= nvc/8
116 nvc2=(nvc-nvc1*8)/4
117 nvc3=(nvc-nvc1*8-nvc2*4)/2
118C
119 IF(nvc1 == 0)THEN
120 IF(jthe == 0) THEN
121#include "vectorize.inc"
122 DO 100 i=jft,jlt
123 nc1 = ixtg(2,i)
124 f(1,nc1)=f(1,nc1)-f11(i)
125 f(2,nc1)=f(2,nc1)-f21(i)
126 f(3,nc1)=f(3,nc1)-f31(i)
127 m(1,nc1)=m(1,nc1)-m11(i)
128 m(2,nc1)=m(2,nc1)-m21(i)
129 m(3,nc1)=m(3,nc1)-m31(i)
130 stifn(nc1)=stifn(nc1)+sti(i)
131 stifr(nc1)=stifr(nc1)+stir(i)
132 100 CONTINUE
133 ELSE
134 IF(nodadt_therm == 1 ) THEN
135#include "vectorize.inc"
136 DO i=jft,jlt
137 nc1 = ixtg(2,i)
138 f(1,nc1)=f(1,nc1)-f11(i)
139 f(2,nc1)=f(2,nc1)-f21(i)
140 f(3,nc1)=f(3,nc1)-f31(i)
141 m(1,nc1)=m(1,nc1)-m11(i)
142 m(2,nc1)=m(2,nc1)-m21(i)
143 m(3,nc1)=m(3,nc1)-m31(i)
144 stifn(nc1)=stifn(nc1)+sti(i)
145 stifr(nc1)=stifr(nc1)+stir(i)
146 fthe(nc1) = fthe(nc1) + them(i,1)
147 condn(nc1)=condn(nc1)+conde(i)
148 ENDDO
149 ELSE
150#include "vectorize.inc"
151 DO i=jft,jlt
152 nc1 = ixtg(2,i)
153 f(1,nc1)=f(1,nc1)-f11(i)
154 f(2,nc1)=f(2,nc1)-f21(i)
155 f(3,nc1)=f(3,nc1)-f31(i)
156 m(1,nc1)=m(1,nc1)-m11(i)
157 m(2,nc1)=m(2,nc1)-m21(i)
158 m(3,nc1)=m(3,nc1)-m31(i)
159 stifn(nc1)=stifn(nc1)+sti(i)
160 stifr(nc1)=stifr(nc1)+stir(i)
161 fthe(nc1) = fthe(nc1) + them(i,1)
162 ENDDO
163 ENDIF
164 ENDIF
165
166 ELSE
167 IF(jthe == 0 ) THEN
168 DO 110 i=jft,jlt
169 nc1 = ixtg(2,i)
170 f(1,nc1)=f(1,nc1)-f11(i)
171 f(2,nc1)=f(2,nc1)-f21(i)
172 f(3,nc1)=f(3,nc1)-f31(i)
173 m(1,nc1)=m(1,nc1)-m11(i)
174 m(2,nc1)=m(2,nc1)-m21(i)
175 m(3,nc1)=m(3,nc1)-m31(i)
176 stifn(nc1)=stifn(nc1)+sti(i)
177 stifr(nc1)=stifr(nc1)+stir(i)
178 110 CONTINUE
179 ELSE
180 IF(nodadt_therm == 1 ) THEN
181 DO i=jft,jlt
182 nc1 = ixtg(2,i)
183 f(1,nc1)=f(1,nc1)-f11(i)
184 f(2,nc1)=f(2,nc1)-f21(i)
185 f(3,nc1)=f(3,nc1)-f31(i)
186 m(1,nc1)=m(1,nc1)-m11(i)
187 m(2,nc1)=m(2,nc1)-m21(i)
188 m(3,nc1)=m(3,nc1)-m31(i)
189 stifn(nc1)=stifn(nc1)+sti(i)
190 stifr(nc1)=stifr(nc1)+stir(i)
191 fthe(nc1) = fthe(nc1) + them(i,1)
192 condn(nc1)=condn(nc1)+conde(i)
193 ENDDO
194 ELSE
195 DO i=jft,jlt
196 nc1 = ixtg(2,i)
197 f(1,nc1)=f(1,nc1)-f11(i)
198 f(2,nc1)=f(2,nc1)-f21(i)
199 f(3,nc1)=f(3,nc1)-f31(i)
200 m(1,nc1)=m(1,nc1)-m11(i)
201 m(2,nc1)=m(2,nc1)-m21(i)
202 m(3,nc1)=m(3,nc1)-m31(i)
203 stifn(nc1)=stifn(nc1)+sti(i)
204 stifr(nc1)=stifr(nc1)+stir(i)
205 fthe(nc1) = fthe(nc1) + them(i,1)
206 ENDDO
207 ENDIF
208 ENDIF
209 ENDIF
210C
211 IF(nvc2 == 0)THEN
212 IF(jthe == 0 ) THEN
213#include "vectorize.inc"
214 DO 200 i=jft,jlt
215 nc2 = ixtg(3,i)
216 f(1,nc2)=f(1,nc2)-f12(i)
217 f(2,nc2)=f(2,nc2)-f22(i)
218 f(3,nc2)=f(3,nc2)-f32(i)
219 m(1,nc2)=m(1,nc2)-m12(i)
220 m(2,nc2)=m(2,nc2)-m22(i)
221 m(3,nc2)=m(3,nc2)-m32(i)
222 stifn(nc2)=stifn(nc2)+sti(i)
223 stifr(nc2)=stifr(nc2)+stir(i)
224 200 CONTINUE
225 ELSE
226 IF(nodadt_therm == 1 ) THEN
227#include "vectorize.inc"
228 DO i=jft,jlt
229 nc2 = ixtg(3,i)
230 f(1,nc2)=f(1,nc2)-f12(i)
231 f(2,nc2)=f(2,nc2)-f22(i)
232 f(3,nc2)=f(3,nc2)-f32(i)
233 m(1,nc2)=m(1,nc2)-m12(i)
234 m(2,nc2)=m(2,nc2)-m22(i)
235 m(3,nc2)=m(3,nc2)-m32(i)
236 stifn(nc2)=stifn(nc2)+sti(i)
237 stifr(nc2)=stifr(nc2)+stir(i)
238 fthe(nc2) = fthe(nc2) + them(i,2)
239 condn(nc2)=condn(nc2)+conde(i)
240 ENDDO
241 ELSE
242#include "vectorize.inc"
243 DO i=jft,jlt
244 nc2 = ixtg(3,i)
245 f(1,nc2)=f(1,nc2)-f12(i)
246 f(2,nc2)=f(2,nc2)-f22(i)
247 f(3,nc2)=f(3,nc2)-f32(i)
248 m(1,nc2)=m(1,nc2)-m12(i)
249 m(2,nc2)=m(2,nc2)-m22(i)
250 m(3,nc2)=m(3,nc2)-m32(i)
251 stifn(nc2)=stifn(nc2)+sti(i)
252 stifr(nc2)=stifr(nc2)+stir(i)
253 fthe(nc2) = fthe(nc2) + them(i,2)
254 ENDDO
255 ENDIF
256 ENDIF
257 ELSE
258 IF(jthe == 0 ) THEN
259 DO 210 i=jft,jlt
260 nc2 = ixtg(3,i)
261 f(1,nc2)=f(1,nc2)-f12(i)
262 f(2,nc2)=f(2,nc2)-f22(i)
263 f(3,nc2)=f(3,nc2)-f32(i)
264 m(1,nc2)=m(1,nc2)-m12(i)
265 m(2,nc2)=m(2,nc2)-m22(i)
266 m(3,nc2)=m(3,nc2)-m32(i)
267 stifn(nc2)=stifn(nc2)+sti(i)
268 stifr(nc2)=stifr(nc2)+stir(i)
269 210 CONTINUE
270 ELSE
271 IF(nodadt_therm == 1 ) THEN
272 DO i=jft,jlt
273 nc2 = ixtg(3,i)
274 f(1,nc2)=f(1,nc2)-f12(i)
275 f(2,nc2)=f(2,nc2)-f22(i)
276 f(3,nc2)=f(3,nc2)-f32(i)
277 m(1,nc2)=m(1,nc2)-m12(i)
278 m(2,nc2)=m(2,nc2)-m22(i)
279 m(3,nc2)=m(3,nc2)-m32(i)
280 stifn(nc2)=stifn(nc2)+sti(i)
281 stifr(nc2)=stifr(nc2)+stir(i)
282 fthe(nc2) = fthe(nc2) + them(i,2)
283 condn(nc2)=condn(nc2)+conde(i)
284 ENDDO
285 ELSE
286 DO i=jft,jlt
287 nc2 = ixtg(3,i)
288 f(1,nc2)=f(1,nc2)-f12(i)
289 f(2,nc2)=f(2,nc2)-f22(i)
290 f(3,nc2)=f(3,nc2)-f32(i)
291 m(1,nc2)=m(1,nc2)-m12(i)
292 m(2,nc2)=m(2,nc2)-m22(i)
293 m(3,nc2)=m(3,nc2)-m32(i)
294 stifn(nc2)=stifn(nc2)+sti(i)
295 stifr(nc2)=stifr(nc2)+stir(i)
296 fthe(nc2) = fthe(nc2) + them(i,2)
297 ENDDO
298 ENDIF
299 ENDIF
300 ENDIF
301C
302 IF(nvc3 == 0)THEN
303 IF(jthe == 0 ) THEN
304#include "vectorize.inc"
305 DO 300 i=jft,jlt
306 nc3 = ixtg(4,i)
307 f(1,nc3)=f(1,nc3)-f13(i)
308 f(2,nc3)=f(2,nc3)-f23(i)
309 f(3,nc3)=f(3,nc3)-f33(i)
310 m(1,nc3)=m(1,nc3)-m13(i)
311 m(2,nc3)=m(2,nc3)-m23(i)
312 m(3,nc3)=m(3,nc3)-m33(i)
313 stifn(nc3)=stifn(nc3)+sti(i)
314 stifr(nc3)=stifr(nc3)+stir(i)
315 300 CONTINUE
316 ELSE
317 IF(nodadt_therm == 1 ) THEN
318#include "vectorize.inc"
319 DO i=jft,jlt
320 nc3 = ixtg(4,i)
321 f(1,nc3)=f(1,nc3)-f13(i)
322 f(2,nc3)=f(2,nc3)-f23(i)
323 f(3,nc3)=f(3,nc3)-f33(i)
324 m(1,nc3)=m(1,nc3)-m13(i)
325 m(2,nc3)=m(2,nc3)-m23(i)
326 m(3,nc3)=m(3,nc3)-m33(i)
327 stifn(nc3)=stifn(nc3)+sti(i)
328 stifr(nc3)=stifr(nc3)+stir(i)
329 fthe(nc3) = fthe(nc3) + them(i,3)
330 condn(nc3)=condn(nc3)+conde(i)
331 ENDDO
332 ELSE
333#include "vectorize.inc"
334 DO i=jft,jlt
335 nc3 = ixtg(4,i)
336 f(1,nc3)=f(1,nc3)-f13(i)
337 f(2,nc3)=f(2,nc3)-f23(i)
338 f(3,nc3)=f(3,nc3)-f33(i)
339 m(1,nc3)=m(1,nc3)-m13(i)
340 m(2,nc3)=m(2,nc3)-m23(i)
341 m(3,nc3)=m(3,nc3)-m33(i)
342 stifn(nc3)=stifn(nc3)+sti(i)
343 stifr(nc3)=stifr(nc3)+stir(i)
344 fthe(nc3) = fthe(nc3) + them(i,3)
345 ENDDO
346 ENDIF
347 ENDIF
348
349 ELSE
350 IF(jthe == 0 ) THEN
351 DO 310 i=jft,jlt
352 nc3 = ixtg(4,i)
353 f(1,nc3)=f(1,nc3)-f13(i)
354 f(2,nc3)=f(2,nc3)-f23(i)
355 f(3,nc3)=f(3,nc3)-f33(i)
356 m(1,nc3)=m(1,nc3)-m13(i)
357 m(2,nc3)=m(2,nc3)-m23(i)
358 m(3,nc3)=m(3,nc3)-m33(i)
359 stifn(nc3)=stifn(nc3)+sti(i)
360 stifr(nc3)=stifr(nc3)+stir(i)
361 310 CONTINUE
362 ELSE
363 IF(nodadt_therm == 1 ) THEN
364 DO i=jft,jlt
365 nc3 = ixtg(4,i)
366 f(1,nc3)=f(1,nc3)-f13(i)
367 f(2,nc3)=f(2,nc3)-f23(i)
368 f(3,nc3)=f(3,nc3)-f33(i)
369 m(1,nc3)=m(1,nc3)-m13(i)
370 m(2,nc3)=m(2,nc3)-m23(i)
371 m(3,nc3)=m(3,nc3)-m33(i)
372 stifn(nc3)=stifn(nc3)+sti(i)
373 stifr(nc3)=stifr(nc3)+stir(i)
374 fthe(nc3) = fthe(nc3) + them(i,3)
375 condn(nc3)=condn(nc3)+conde(i)
376 ENDDO
377 ELSE
378 DO i=jft,jlt
379 nc3 = ixtg(4,i)
380 f(1,nc3)=f(1,nc3)-f13(i)
381 f(2,nc3)=f(2,nc3)-f23(i)
382 f(3,nc3)=f(3,nc3)-f33(i)
383 m(1,nc3)=m(1,nc3)-m13(i)
384 m(2,nc3)=m(2,nc3)-m23(i)
385 m(3,nc3)=m(3,nc3)-m33(i)
386 stifn(nc3)=stifn(nc3)+sti(i)
387 stifr(nc3)=stifr(nc3)+stir(i)
388 fthe(nc3) = fthe(nc3) + them(i,3)
389 ENDDO
390 ENDIF
391 ENDIF
392 ENDIF
393C-----------
394 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

◆ c3updt3p()

subroutine c3updt3p ( integer jft,
integer jlt,
offg,
off,
sti,
stir,
fsky,
fskyv,
integer, dimension(3,*) iadtg,
f11,
f12,
f13,
f21,
f22,
f23,
f31,
f32,
f33,
m11,
m12,
m13,
m21,
m22,
m23,
m31,
m32,
m33,
integer jthe,
them,
fthesky,
eint,
pm,
area,
thk,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) iparttg,
condnsky,
conde,
integer, intent(in) nodadt_therm )

Definition at line 402 of file c3updt3.F.

411C-----------------------------------------------
412C I m p l i c i t T y p e s
413C-----------------------------------------------
414#include "implicit_f.inc"
415C-----------------------------------------------
416C G l o b a l P a r a m e t e r s
417C-----------------------------------------------
418#include "mvsiz_p.inc"
419C-----------------------------------------------
420C C o m m o n B l o c k s
421C-----------------------------------------------
422#include "param_c.inc"
423#include "parit_c.inc"
424#include "scr18_c.inc"
425C-----------------------------------------------
426C D u m m y A r g u m e n t s
427C-----------------------------------------------
428 INTEGER ,INTENT(IN) :: NODADT_THERM
429 INTEGER JFT, JLT, IADTG(3,*),JTHE,MAT(MVSIZ),IPARTTG(*)
430 my_real
431 . offg(*), off(*), sti(*), stir(*), fskyv(lsky,8),
432 . fsky(8,lsky)
433 my_real f11(mvsiz), f12(mvsiz), f13(mvsiz),
434 . f21(mvsiz), f22(mvsiz), f23(mvsiz),
435 . f31(mvsiz), f32(mvsiz), f33(mvsiz),
436 . m11(mvsiz), m12(mvsiz), m13(mvsiz),
437 . m21(mvsiz), m22(mvsiz), m23(mvsiz),
438 . m31(mvsiz), m32(mvsiz), m33(mvsiz),
439 . conde(mvsiz),
440 . them(mvsiz,3),fthesky(lsky),condnsky(*),
441 . eint(jlt,2),pm(npropm,*),area(*),thk(*),partsav(npsav,*)
442C-----------------------------------------------
443C L o c a l V a r i a b l e s
444C-----------------------------------------------
445 INTEGER I, K
446 my_real
447 . off_l
448C=======================================================================
449C cumulative energy of deleted elements AT the time of deletion
450 off_l = zero
451 DO i=jft,jlt
452 IF (off(i) < one) offg(i) = off(i)
453 off_l = min(off_l,offg(i))
454 ENDDO
455 IF(off_l < zero)THEN
456 DO i=jft,jlt
457 IF(offg(i) < zero)THEN
458 f11(i)=zero
459 f21(i)=zero
460 f31(i)=zero
461 m11(i)=zero
462 m21(i)=zero
463 m31(i)=zero
464 f12(i)=zero
465 f22(i)=zero
466 f32(i)=zero
467 m12(i)=zero
468 m22(i)=zero
469 m32(i)=zero
470 f13(i)=zero
471 f23(i)=zero
472 f33(i)=zero
473 m13(i)=zero
474 m23(i)=zero
475 m33(i)=zero
476 sti(i)=zero
477 stir(i)=zero
478 conde(i)=zero
479c THEM(I,1) = ZERO
480c THEM(I,2) = ZERO
481c THEM(I,3) = ZERO
482 ENDIF
483 ENDDO
484 ENDIF
485C
486 IF(jthe == 0 ) THEN
487 IF (ivector == 1) THEN
488#include "vectorize.inc"
489 DO i=jft,jlt
490 k = iadtg(1,i)
491 fskyv(k,1)=-f11(i)
492 fskyv(k,2)=-f21(i)
493 fskyv(k,3)=-f31(i)
494 fskyv(k,4)=-m11(i)
495 fskyv(k,5)=-m21(i)
496 fskyv(k,6)=-m31(i)
497 fskyv(k,7)=sti(i)
498 fskyv(k,8)=stir(i)
499 k = iadtg(2,i)
500 fskyv(k,1)=-f12(i)
501 fskyv(k,2)=-f22(i)
502 fskyv(k,3)=-f32(i)
503 fskyv(k,4)=-m12(i)
504 fskyv(k,5)=-m22(i)
505 fskyv(k,6)=-m32(i)
506 fskyv(k,7)=sti(i)
507 fskyv(k,8)=stir(i)
508 k = iadtg(3,i)
509 fskyv(k,1)=-f13(i)
510 fskyv(k,2)=-f23(i)
511 fskyv(k,3)=-f33(i)
512 fskyv(k,4)=-m13(i)
513 fskyv(k,5)=-m23(i)
514 fskyv(k,6)=-m33(i)
515 fskyv(k,7)=sti(i)
516 fskyv(k,8)=stir(i)
517 ENDDO
518 ELSE
519 DO i=jft,jlt
520 k = iadtg(1,i)
521 fsky(1,k)=-f11(i)
522 fsky(2,k)=-f21(i)
523 fsky(3,k)=-f31(i)
524 fsky(4,k)=-m11(i)
525 fsky(5,k)=-m21(i)
526 fsky(6,k)=-m31(i)
527 fsky(7,k)=sti(i)
528 fsky(8,k)=stir(i)
529 k = iadtg(2,i)
530 fsky(1,k)=-f12(i)
531 fsky(2,k)=-f22(i)
532 fsky(3,k)=-f32(i)
533 fsky(4,k)=-m12(i)
534 fsky(5,k)=-m22(i)
535 fsky(6,k)=-m32(i)
536 fsky(7,k)=sti(i)
537 fsky(8,k)=stir(i)
538 k = iadtg(3,i)
539 fsky(1,k)=-f13(i)
540 fsky(2,k)=-f23(i)
541 fsky(3,k)=-f33(i)
542 fsky(4,k)=-m13(i)
543 fsky(5,k)=-m23(i)
544 fsky(6,k)=-m33(i)
545 fsky(7,k)=sti(i)
546 fsky(8,k)=stir(i)
547 ENDDO
548 ENDIF
549 ELSE
550 IF (ivector == 1) THEN
551 IF(nodadt_therm == 1) THEN
552#include "vectorize.inc"
553 DO i=jft,jlt
554 k = iadtg(1,i)
555 fskyv(k,1)=-f11(i)
556 fskyv(k,2)=-f21(i)
557 fskyv(k,3)=-f31(i)
558 fskyv(k,4)=-m11(i)
559 fskyv(k,5)=-m21(i)
560 fskyv(k,6)=-m31(i)
561 fskyv(k,7)=sti(i)
562 fskyv(k,8)=stir(i)
563 fthesky(k) = them(i,1)
564 condnsky(k) = conde(i)
565 k = iadtg(2,i)
566 fskyv(k,1)=-f12(i)
567 fskyv(k,2)=-f22(i)
568 fskyv(k,3)=-f32(i)
569 fskyv(k,4)=-m12(i)
570 fskyv(k,5)=-m22(i)
571 fskyv(k,6)=-m32(i)
572 fskyv(k,7)=sti(i)
573 fskyv(k,8)=stir(i)
574 fthesky(k) = them(i,2)
575 condnsky(k) = conde(i)
576 k = iadtg(3,i)
577 fskyv(k,1)=-f13(i)
578 fskyv(k,2)=-f23(i)
579 fskyv(k,3)=-f33(i)
580 fskyv(k,4)=-m13(i)
581 fskyv(k,5)=-m23(i)
582 fskyv(k,6)=-m33(i)
583 fskyv(k,7)=sti(i)
584 fskyv(k,8)=stir(i)
585 fthesky(k) = them(i,3)
586 condnsky(k) = conde(i)
587 ENDDO
588 ELSE
589#include "vectorize.inc"
590 DO i=jft,jlt
591 k = iadtg(1,i)
592 fskyv(k,1)=-f11(i)
593 fskyv(k,2)=-f21(i)
594 fskyv(k,3)=-f31(i)
595 fskyv(k,4)=-m11(i)
596 fskyv(k,5)=-m21(i)
597 fskyv(k,6)=-m31(i)
598 fskyv(k,7)=sti(i)
599 fskyv(k,8)=stir(i)
600 fthesky(k) = them(i,1)
601 condnsky(k) = conde(i)
602 k = iadtg(2,i)
603 fskyv(k,1)=-f12(i)
604 fskyv(k,2)=-f22(i)
605 fskyv(k,3)=-f32(i)
606 fskyv(k,4)=-m12(i)
607 fskyv(k,5)=-m22(i)
608 fskyv(k,6)=-m32(i)
609 fskyv(k,7)=sti(i)
610 fskyv(k,8)=stir(i)
611 fthesky(k) = them(i,2)
612 condnsky(k) = conde(i)
613 k = iadtg(3,i)
614 fskyv(k,1)=-f13(i)
615 fskyv(k,2)=-f23(i)
616 fskyv(k,3)=-f33(i)
617 fskyv(k,4)=-m13(i)
618 fskyv(k,5)=-m23(i)
619 fskyv(k,6)=-m33(i)
620 fskyv(k,7)=sti(i)
621 fskyv(k,8)=stir(i)
622 fthesky(k) = them(i,3)
623 condnsky(k) = conde(i)
624 ENDDO
625 ENDIF
626 ELSE
627 IF(nodadt_therm == 1) THEN
628 DO i=jft,jlt
629 k = iadtg(1,i)
630 fsky(1,k)=-f11(i)
631 fsky(2,k)=-f21(i)
632 fsky(3,k)=-f31(i)
633 fsky(4,k)=-m11(i)
634 fsky(5,k)=-m21(i)
635 fsky(6,k)=-m31(i)
636 fsky(7,k)=sti(i)
637 fsky(8,k)=stir(i)
638 fthesky(k) = them(i,1)
639 k = iadtg(2,i)
640 fsky(1,k)=-f12(i)
641 fsky(2,k)=-f22(i)
642 fsky(3,k)=-f32(i)
643 fsky(4,k)=-m12(i)
644 fsky(5,k)=-m22(i)
645 fsky(6,k)=-m32(i)
646 fsky(7,k)=sti(i)
647 fsky(8,k)=stir(i)
648 fthesky(k) = them(i,2)
649 k = iadtg(3,i)
650 fsky(1,k)=-f13(i)
651 fsky(2,k)=-f23(i)
652 fsky(3,k)=-f33(i)
653 fsky(4,k)=-m13(i)
654 fsky(5,k)=-m23(i)
655 fsky(6,k)=-m33(i)
656 fsky(7,k)=sti(i)
657 fsky(8,k)=stir(i)
658 fthesky(k) = them(i,3)
659 ENDDO
660 ELSE
661 DO i=jft,jlt
662 k = iadtg(1,i)
663 fsky(1,k)=-f11(i)
664 fsky(2,k)=-f21(i)
665 fsky(3,k)=-f31(i)
666 fsky(4,k)=-m11(i)
667 fsky(5,k)=-m21(i)
668 fsky(6,k)=-m31(i)
669 fsky(7,k)=sti(i)
670 fsky(8,k)=stir(i)
671 fthesky(k) = them(i,1)
672 k = iadtg(2,i)
673 fsky(1,k)=-f12(i)
674 fsky(2,k)=-f22(i)
675 fsky(3,k)=-f32(i)
676 fsky(4,k)=-m12(i)
677 fsky(5,k)=-m22(i)
678 fsky(6,k)=-m32(i)
679 fsky(7,k)=sti(i)
680 fsky(8,k)=stir(i)
681 fthesky(k) = them(i,2)
682 k = iadtg(3,i)
683 fsky(1,k)=-f13(i)
684 fsky(2,k)=-f23(i)
685 fsky(3,k)=-f33(i)
686 fsky(4,k)=-m13(i)
687 fsky(5,k)=-m23(i)
688 fsky(6,k)=-m33(i)
689 fsky(7,k)=sti(i)
690 fsky(8,k)=stir(i)
691 fthesky(k) = them(i,3)
692 ENDDO
693 ENDIF
694 ENDIF
695
696 ENDIF
697C-----------
698 RETURN