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"

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

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

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