OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
asspar4.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "scr18_c.inc"
#include "sphcom.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine asspar4 (nodes, fsky, fskyv, adsky, fskym, msnf, isky, fskyi, fthe, fthesky, ftheskyi, nodft, nodlt, adskyi, partsav, partft, partlt, itask, greft, grelt, gresav, af, ffsky, msf, adsky_pxfem, inod_pxfem, fskyd, dmsph, condn, condnsky, condnskyi, ms_2d, icnds10, stifnd, forneqs, forneqsky, nfacnit, nodft_2, nodlt_2, fsky_l, glob_therm)
subroutine asspari2 (a, ar, stifn, stifr, ms, in, fskyi2, i2size, addcni2, indsky, ftheskyi2, fthe, condnskyi2, condn, glob_therm)

Function/Subroutine Documentation

◆ asspar4()

subroutine asspar4 ( type(nodal_arrays_), intent(inout) nodes,
fsky,
fskyv,
integer, dimension(*) adsky,
fskym,
msnf,
integer, dimension(*) isky,
fskyi,
fthe,
fthesky,
ftheskyi,
integer nodft,
integer nodlt,
integer, dimension(0:numnod+1) adskyi,
partsav,
integer partft,
integer partlt,
integer itask,
integer greft,
integer grelt,
gresav,
af,
ffsky,
msf,
integer, dimension(*) adsky_pxfem,
integer, dimension(*) inod_pxfem,
fskyd,
dmsph,
condn,
condnsky,
condnskyi,
ms_2d,
integer, dimension(3,*) icnds10,
stifnd,
forneqs,
forneqsky,
integer nfacnit,
integer nodft_2,
integer nodlt_2,
intent(inout) fsky_l,
type (glob_therm_), intent(inout) glob_therm )

Definition at line 38 of file asspar4.F.

48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE nodal_arrays_mod
52 USE connectivity_mod
53 USE plyxfem_mod
54 USE ale_mod
55 use glob_therm_mod
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60#include "comlock.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "com08_c.inc"
67#include "parit_c.inc"
68#include "units_c.inc"
69#include "param_c.inc"
70#include "task_c.inc"
71#include "scr18_c.inc"
72#include "sphcom.inc"
73C-----------------------------------------------
74 INTEGER MAXBLOC,NBLOC,NBVAL,NBCOL,NFACNIT
75 parameter(maxbloc=1000)
76 common/ptmparit/nbloc,nbval(1:maxbloc),nbcol(1:maxbloc)
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C----------------------------------------------
80 TYPE(nodal_arrays_), intent(inout) :: NODES
81 INTEGER ADSKY(*), ISKY(*),
82 . ADSKYI(0:NUMNOD+1),
83 . NODFT, NODLT, ITASK, PARTFT, PARTLT,GREFT,GRELT,
84 . ADSKY_PXFEM(*),INOD_PXFEM(*), ICNDS10(3,*),NODFT_2 ,NODLT_2
85
86C REAL
87 my_real
88 . fskyv(lsky,8),fsky(8,lsky),
89 . fskym(*), msnf(*), fskyi(lskyi,nfskyi),
90 . fthe(*), fthesky(lsky), ftheskyi(lskyi), partsav(*),gresav(*),
91 . af(3,*),ffsky(3,*),msf(*), fskyd(*), dmsph(*),condnsky(lsky),condn(*),
92 . condnskyi(lskyi),ms_2d(*),stifnd(*),forneqs(3,*) ,
93 . forneqsky(3*nfacnit,*)
94 my_real, DIMENSION(NISKY), INTENT(INOUT) :: fsky_l !< working array for FSKY sorting
95 type (glob_therm_) ,intent(inout) :: glob_therm
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER VSIZE, NBCC, NUM7, KM,IL,IPLY,ND
100 parameter(vsize = 8192)
101 parameter(nbcc = 20)
102 INTEGER I,J,L,K,N,NC,KK,JJ,JJ1,JJ2,NN,NFSKYFT_INTPLY,NFSKYLT_INTPLY,
103 . NISKYFT,NISKYLT,NFSKYFT,NFSKYLT,K1,K2,K3,IJK,NF,
104 . NCT,DIFFADD,NDLT,NDFT,LJ,KKEND,NSTART,KKSTART,KMAX,KSPLIT
105 INTEGER IC(NBCC+1),NN_A(VSIZE),IARRAY(VSIZE)
106 my_real ff, fskyt(nisky)
107 INTEGER :: VIND_SIZE
108 INTEGER, DIMENSION(:), ALLOCATABLE :: VIND1,VIND2,VIND3
109 INTEGER :: CHUNK_NODE,CHUNK_NODE_1
110 INTEGER, PARAMETER :: IVSIZE = 32
111C-----------------------------------------------
112C Partie ELEMENT
113C-----------------------------------------------
114
115 vind_size=max(nodlt-nodft+1,ivsize)
116 ALLOCATE(vind1(vind_size))
117 ALLOCATE(vind2(vind_size))
118 ALLOCATE(vind3(vind_size))
119 chunk_node = int(numnod / (10*nthread))
120 if( chunk_node<2) chunk_node = int(numnod/nthread)
121 chunk_node = max(1,chunk_node)
122 chunk_node_1 = (numnod+2)/ (10*nthread)
123 if( chunk_node_1<2) chunk_node_1 = (numnod+1)/nthread
124 chunk_node_1 = max(1,chunk_node_1)
125
126!$OMP DO SCHEDULE(guided)
127 DO n = 1,numnod+1
128 adskyi(n) = 0
129 ENDDO
130!$OMP END DO
131!$OMP SINGLE
132 DO i=1,nisky
133 n = isky(i)+1
134 adskyi(n) = adskyi(n)+1
135 ENDDO
136C-----------------------------------------------
137C CALCUL DES ADRESSES DU VECTEUR SKYLINE
138C-----------------------------------------------
139 adskyi(0) = 1
140 adskyi(1) = 1
141 DO n = 1, numnod
142 nn = n+1
143 adskyi(nn) = adskyi(nn) + adskyi(n)
144 ENDDO
145C-----------------------------------------------
146C TRI DES FORCES EN SKYLINE
147C-----------------------------------------------
148 DO i=1,nisky
149 n = isky(i)
150 j = adskyi(n)
151 isky(i) = j
152 adskyi(n) = adskyi(n) + 1
153 ENDDO
154!$OMP END SINGLE NOWAIT
155
156 ! ------------------------------
157 IF(glob_therm%ITHERM_FE == 0 ) THEN
158 ! --------------
159 IF(ale%SUB%IFSUBM==0)THEN
160!$OMP DO SCHEDULE(guided)
161 DO n = 1,numnod
162 nct = adsky(n)-1
163 nc = adsky(n+1)-adsky(n)
164 DO k = nct+1, nct+nc ! ADSKY(N) to ADSKY(N+1)-1
165 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
166 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
167 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
168 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
169 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
170 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
171 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
172 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
173 ENDDO
174 ENDDO
175!$OMP END DO
176 ! --------------
177 ELSEIF(n2d/=0)THEN
178!$OMP DO SCHEDULE(guided)
179 DO n = 1,numnod
180 nct = adsky(n)-1
181 nc = adsky(n+1)-adsky(n)
182 DO k = nct+1, nct+nc
183 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
184 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
185 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
186 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
187 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
188 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
189 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
190 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
191 ms_2d(n) = ms_2d(n) + fskym(k)
192 ENDDO
193 ENDDO
194!$OMP END DO
195 ! --------------
196 ELSE
197!$OMP DO SCHEDULE(guided)
198 DO n = 1,numnod
199 nct = adsky(n)-1
200 nc = adsky(n+1)-adsky(n)
201 DO k = nct+1, nct+nc
202 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
203 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
204 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
205 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
206 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
207 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
208 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
209 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
210 msnf(n) = msnf(n) + fskym(k)
211 ENDDO
212 ENDDO
213!$OMP END DO
214 ENDIF
215 ! --------------
216 ! ------------------------------
217 ELSE
218 ! --------------
219 IF(glob_therm%NODADT_THERM == 1) THEN
220 ! --------------
221 IF(ale%SUB%IFSUBM==0)THEN
222!$OMP DO SCHEDULE(guided)
223 DO n = 1,numnod
224 nct = adsky(n)-1
225 nc = adsky(n+1)-adsky(n)
226 DO k = nct+1, nct+nc
227 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
228 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
229 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
230 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
231 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
232 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
233 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
234 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
235 fthe(n) = fthe(n) + fthesky(k)
236 condn(n) = condn(n) + condnsky(k)
237 ENDDO
238 ENDDO
239!$OMP END DO
240 ! --------------
241 ELSEIF(n2d/=0)THEN
242!$OMP DO SCHEDULE(guided)
243 DO n = 1,numnod
244 nct = adsky(n)-1
245 nc = adsky(n+1)-adsky(n)
246 DO k = nct+1, nct+nc
247 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
248 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
249 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
250 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
251 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
252 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
253 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
254 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
255 fthe(n) = fthe(n) + fthesky(k)
256 condn(n) = condn(n) + condnsky(k)
257 ms_2d(n) = ms_2d(n) + fskym(k)
258 ENDDO
259 ENDDO
260!$OMP END DO
261 ! --------------
262 ELSE
263!$OMP DO SCHEDULE(guided)
264 DO n = 1,numnod
265 nct = adsky(n)-1
266 nc = adsky(n+1)-adsky(n)
267 DO k = nct+1, nct+nc
268 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
269 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
270 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
271 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
272 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
273 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
274 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
275 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
276 msnf(n) = msnf(n) + fskym(k)
277 fthe(n) = fthe(n) + fthesky(k)
278 condn(n) = condn(n) + condnsky(k)
279 ENDDO
280 ENDDO
281!$OMP END DO
282 ENDIF
283 ! --------------
284 ! --------------
285 ELSE ! GLOB_THERM%NODADT_THERM/=1
286 ! --------------
287 IF(ale%SUB%IFSUBM==0)THEN
288!$OMP DO SCHEDULE(guided)
289 DO n = 1,numnod
290 nct = adsky(n)-1
291 nc = adsky(n+1)-adsky(n)
292 DO k = nct+1, nct+nc
293 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
294 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
295 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
296 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
297 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
298 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
299 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
300 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
301 fthe(n) = fthe(n) + fthesky(k)
302 ENDDO
303 ENDDO
304!$OMP END DO
305 ! --------------
306 ELSEIF(n2d/=0)THEN
307!$OMP DO SCHEDULE(guided)
308 DO n = 1,numnod
309 nct = adsky(n)-1
310 nc = adsky(n+1)-adsky(n)
311 DO k = nct+1, nct+nc
312 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
313 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
314 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
315 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
316 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
317 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
318 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
319 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
320 fthe(n) = fthe(n) + fthesky(k)
321 ms_2d(n) = ms_2d(n) + fskym(k)
322 ENDDO
323 ENDDO
324!$OMP END DO
325 ! --------------
326 ELSE
327!$OMP DO SCHEDULE(guided)
328 DO n = 1,numnod
329 nct = adsky(n)-1
330 nc = adsky(n+1)-adsky(n)
331 DO k = nct+1, nct+nc
332 nodes%A(1,n) = nodes%A(1,n) + fsky(1,k)
333 nodes%A(2,n) = nodes%A(2,n) + fsky(2,k)
334 nodes%A(3,n) = nodes%A(3,n) + fsky(3,k)
335 nodes%AR(1,n) = nodes%AR(1,n) + fsky(4,k)
336 nodes%AR(2,n) = nodes%AR(2,n) + fsky(5,k)
337 nodes%AR(3,n) = nodes%AR(3,n) + fsky(6,k)
338 nodes%STIFN(n) = nodes%STIFN(n) + fsky(7,k)
339 nodes%STIFR(n) = nodes%STIFR(n) + fsky(8,k)
340 msnf(n) = msnf(n) + fskym(k)
341 fthe(n) = fthe(n) + fthesky(k)
342 ENDDO
343 ENDDO
344!$OMP END DO
345 ENDIF
346 ! --------------
347 ENDIF
348 ! --------------
349 ENDIF
350 ! ------------------------------
351
352 ! ------------------------------
353 ! simplified flow
354 IF(ialelag > 0) THEN
355!$OMP DO SCHEDULE(guided)
356 DO n = 1,numnod
357 nct = adsky(n)-1
358 nc = adsky(n+1)-adsky(n)
359 DO k = nct+1, nct+nc
360 af(1,n) = af(1,n) + ffsky(1,k)
361 af(2,n) = af(2,n) + ffsky(2,k)
362 af(3,n) = af(3,n) + ffsky(3,k)
363 msnf(n) = msnf(n) + fskym(k)
364 ENDDO
365 ENDDO
366!$OMP END DO
367 ENDIF
368 ! ------------------------------
369
370C-----------------------------------------------
371C SUPPRESS MASS DELETED SOLIDS (SOLIDS to SPH)
372C-----------------------------------------------
373 IF(sol2sph_flag/=0)THEN
374!$OMP DO SCHEDULE(guided)
375 DO n = 1,numnod
376 nct = adsky(n)-1
377 nc = adsky(n+1)-adsky(n)
378 DO k = nct+1, nct+nc
379 dmsph(n) = dmsph(n) + fskyd(k)
380 ENDDO
381 ENDDO
382!$OMP END DO
383 END IF
384C-----------------------------------------------
385C FORCES D'ELEMENTS by ply
386C-----------------------------------------------
387
388 IF(iplyxfem > 0) THEN
389!$OMP DO SCHEDULE(guided)
390 DO n = 1,numnod
391 il = inod_pxfem(n)
392 IF(il > 0) THEN
393 nct = adsky_pxfem(il) - 1
394 nc = adsky_pxfem(il+1) - adsky_pxfem(il)
395 DO k = nct+1, nct+nc
396 DO j=1,nplymax
397 ply(j)%A(1,il) = ply(j)%A(1,il) + plysky(j)%FSKY(1,k)
398 ply(j)%A(2,il) = ply(j)%A(2,il) + plysky(j)%FSKY(2,k)
399 ply(j)%A(3,il) = ply(j)%A(3,il) + plysky(j)%FSKY(3,k)
400 ply(j)%A(4,il) = ply(j)%A(4,il) + plysky(j)%FSKY(4,k)
401 ENDDO
402 ENDDO
403 ENDIF
404 ENDDO
405!$OMP END DO
406 ENDIF
407
408 IF( (n2d/=0).OR.(ale%SUB%IFSUBM==1).OR.(ialelag > 0) ) CALL my_barrier
409
410C masse stocke dans FSKY(1) et NODES%A(1) utilise pour cumul en 2D
411 IF(n2d/=0) THEN
412!$omp DO schedule(guided)
413 DO i = 1,numnod
414 nodes%MS(i) = nodes%A(1,i)
415 nodes%A(1,i) = zero
416 ENDDO
417!$OMP END DO
418 ELSEIF(ale%SUB%IFSUBM==1)THEN
419!$OMP DO SCHEDULE(guided)
420 DO i = 1,numnod
421 nodes%MS(i) = nodes%MS(i) + msnf(i)
422 ENDDO
423!$OMP END DO
424 ENDIF
425C
426 IF(ialelag > 0) THEN
427!$OMP DO SCHEDULE(guided)
428 DO i = 1,numnod
429 msf(i) = msf(i) + msnf(i)
430 ENDDO
431!$OMP END DO
432 ENDIF
433C-----------------------------------------------
434C ITET=2 restore elementary STIFN of ND(middle node)
435C-----------------------------------------------
436 IF(ns10e>0) THEN
437 CALL my_barrier
438!$OMP SINGLE
439#include "vectorize.inc"
440 DO i=1,ns10e
441 nd = iabs(icnds10(1,i))
442 stifnd(i) = nodes%STIFN(nd)
443 ENDDO
444!$OMP END SINGLE
445 ENDIF
446C-----------------------------------------------
447C Partie NITSCHE ELEM FORNEQS
448C-----------------------------------------------
449 IF(nitsche /= 0) THEN
450!$OMP DO SCHEDULE(guided)
451 DO n = 1,numnod !NODFT, NODLT
452 nct = adsky(n)-1
453 nc = adsky(n+1)-adsky(n)
454 DO k = nct+1, nct+nc
455 DO nf=1,nfacnit
456 forneqs(1,n) = forneqs(1,n) + forneqsky(3*(nf-1)+1,k)
457 forneqs(2,n) = forneqs(2,n) + forneqsky(3*(nf-1)+2,k)
458 forneqs(3,n) = forneqs(3,n) + forneqsky(3*(nf-1)+3,k)
459 ENDDO
460 ENDDO
461 ENDDO
462!$OMP END DO
463 ENDIF
464
465C-----------------------------------------------
466C Partie INTERFACE
467C-----------------------------------------------
468 IF(nisky>lskyi)THEN
469 WRITE(iout,*) ' **ERROR** : MEMORY PROBLEM IN PARITH OPTION'
470 WRITE(iout,*)
471 . ' PLEASE, INCREASE MULTIMP FOR INTERFACES 7, 10 AND 11'
472 WRITE(istdo,*)' **ERROR** : MEMORY PROBLEM IN PARITH OPTION'
473 tstop=zero
474
475 RETURN
476 ENDIF
477C
478 IF (nisky/=0) THEN
479 niskyft = 1+itask*nisky/ nthread
480 niskylt = (itask+1)*nisky/nthread
481 nfskyft = 1+itask*nfskyi/ nthread
482 nfskylt = (itask+1)*nfskyi/nthread
483
484 IF(intplyxfem > 0 ) THEN
485 nfskyft_intply = 1+itask*5/ nthread
486 nfskylt_intply = (itask+1)*5/nthread
487 ENDIF
488C-----------------------------------------------
489C Partie //
490C-----------------------------------------------
491 DO l=1,nfskyi
492!$OMP DO SCHEDULE(guided)
493 DO i=1,nisky
494 j = isky(i) ! address for N per contribution
495 fsky_l(j) = fskyi(i,l) ! FSKYT : contribution triée par noeud
496 END DO
497!$OMP END DO
498 call my_barrier()
499!$OMP DO SCHEDULE(guided)
500 DO i=1,nisky
501 fskyi(i,l) = fsky_l(i)
502 END DO
503!$OMP END DO
504 ENDDO
505C
506 IF(glob_therm%INTHEAT > 0 ) THEN
507!$OMP SINGLE
508 DO i=1,nisky
509 j = isky(i)
510 fskyt(j) = ftheskyi(i)
511 ENDDO
512 DO i=1,nisky
513 ftheskyi(i) = fskyt(i)
514 ENDDO
515!$OMP END SINGLE
516 IF(glob_therm%NODADT_THERM ==1 ) THEN
517!$OMP SINGLE
518 DO i=1,nisky
519 j = isky(i)
520 fskyt(j) = condnskyi(i)
521 ENDDO
522 DO i=1,nisky
523 condnskyi(i) = fskyt(i)
524 ENDDO
525!$OMP END SINGLE
526 ENDIF
527 ENDIF
528C
529 IF(intplyxfem > 0) THEN
530 DO l = nfskyft_intply,nfskylt_intply
531 DO i=1,nisky
532 j = isky(i)
533 fskyt(j) = plyskyi%FSKYI(i,l)
534 END DO
535 DO i=1,nisky
536 plyskyi%FSKYI(i,l) = fskyt(i)
537 END DO
538 ENDDO
539 ENDIF
540C
541C Barriere FSKYI et NISKY
542C
543 CALL my_barrier
544 nisky = 0
545C-----------------------------------------------
546C FORCES D'INTERFACES
547C-----------------------------------------------
548
549!$OMP DO SCHEDULE(dynamic,IVSIZE)
550 DO ndft = 1,numnod,ivsize
551
552 ndlt = min(ndft+ivsize-1,numnod)
553 k1 = 0
554 k2 = 0
555 k3 = 0
556 DO n=ndft,ndlt
557 nn = n-1
558 diffadd = adskyi(n)-1-adskyi(nn)
559 IF(diffadd==0) THEN
560 k1 = k1 + 1
561 vind1(k1) = n
562C 20 valeur seuil pour appel a qsort (20 = NBCC)
563 ELSEIF(diffadd>=1.AND.diffadd<nbcc) THEN
564 k2 = k2 + 1
565 vind2(k2) = n
566 ELSEIF(diffadd>=nbcc) THEN
567 k3 = k3 + 1
568 vind3(k3) = n
569 ENDIF
570 ENDDO
571C
572C une seule contribution
573C
574 IF(glob_therm%INTHEAT == 0 ) THEN
575 IF(kdtint==0)THEN
576#include "vectorize.inc"
577 DO ijk=1,k1
578 n = vind1(ijk)
579 k=adskyi(n-1)
580 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
581 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
582 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
583 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
584 ENDDO
585 ELSE
586#include "vectorize.inc"
587 DO ijk=1,k1
588 n = vind1(ijk)
589 k=adskyi(n-1)
590 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
591 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
592 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
593 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
594 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
595 ENDDO
596 ENDIF
597C + la thermique
598 ELSE
599 IF(glob_therm%NODADT_THERM == 1) THEN
600 IF(kdtint==0)THEN
601#include "vectorize.inc"
602 DO ijk=1,k1
603 n = vind1(ijk)
604 k=adskyi(n-1)
605 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
606 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
607 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
608 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
609 fthe(n) = fthe(n) + ftheskyi(k)
610 condn(n) = condn(n) + condnskyi(k)
611 ftheskyi(k) = zero
612 ENDDO
613 ELSE
614#include "vectorize.inc"
615 DO ijk=1,k1
616 n = vind1(ijk)
617 k=adskyi(n-1)
618 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
619 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
620 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
621 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
622 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
623 fthe(n) = fthe(n) + ftheskyi(k)
624 condn(n) = condn(n) + condnskyi(k)
625 ftheskyi(k) = zero
626 ENDDO
627 ENDIF
628 ELSE
629 IF(kdtint==0)THEN
630#include "vectorize.inc"
631 DO ijk=1,k1
632 n = vind1(ijk)
633 k=adskyi(n-1)
634 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
635 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
636 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
637 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
638 fthe(n) = fthe(n) + ftheskyi(k)
639 ftheskyi(k) = zero
640 ENDDO
641 ELSE
642#include "vectorize.inc"
643 DO ijk=1,k1
644 n = vind1(ijk)
645 k=adskyi(n-1)
646 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
647 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
648 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
649 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
650 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
651 fthe(n) = fthe(n) + ftheskyi(k)
652 ftheskyi(k) = zero
653 ENDDO
654 ENDIF
655 ENDIF
656
657 ENDIF
658C
659C for plyxfem node
660C
661
662 IF(intplyxfem > 0) THEN
663#include "vectorize.inc"
664 DO ijk=1,k1
665 n = vind1(ijk)
666 k=adskyi(n-1)
667 il = inod_pxfem(n)
668 IF(il > 0) THEN
669C Iply is the position of ply in contact
670 iply = int(plyskyi%FSKYI(k,5))
671 IF(iply > 0) THEN
672 ply(iply)%A(1,il)=ply(iply)%A(1,il) + plyskyi%FSKYI(k,1)
673 ply(iply)%A(2,il)=ply(iply)%A(2,il) + plyskyi%FSKYI(k,2)
674 ply(iply)%A(3,il)=ply(iply)%A(3,il) + plyskyi%FSKYI(k,3)
675 ply(iply)%A(4,il)=ply(iply)%A(4,il) + plyskyi%FSKYI(k,4)
676 ENDIF
677 ENDIF
678 ENDDO
679 ENDIF
680C
681C pas plus de 20 contributions
682C
683 IF (ivector==0) THEN
684C ANCIEN CODE
685 DO 800 ijk=1,k2
686 n = vind2(ijk)
687 nn = n-1
688 jj1 = adskyi(nn)
689 jj2 = adskyi(n)-1
690C-----------------------------------------------
691C TRI DES FORCES D'INTERFACES
692C-----------------------------------------------
693 IF(glob_therm%INTHEAT == 0 ) THEN
694 DO 500 k=jj1,jj2-1
695 DO 500 kk=k+1,jj2
696 DO 500 l=1,nfskyi
697 IF(fskyi(kk,l)>fskyi(k,l))THEN
698 ff = fskyi(kk,l)
699 fskyi(kk,l) = fskyi(k,l)
700 fskyi(k,l) = ff
701 ENDIF
702 500 CONTINUE
703C + la thermique
704 ELSE
705 IF(glob_therm%NODADT_THERM == 1 ) THEN
706 DO k=jj1,jj2-1
707 DO kk=k+1,jj2
708 DO l=1,nfskyi
709 IF(fskyi(kk,l)>fskyi(k,l))THEN
710 ff = fskyi(kk,l)
711 fskyi(kk,l) = fskyi(k,l)
712 fskyi(k,l) = ff
713 ENDIF
714 ENDDO
715 IF(ftheskyi(kk)>ftheskyi(k))THEN
716 ff = ftheskyi(kk)
717 ftheskyi(kk) = ftheskyi(k)
718 ftheskyi(k) = ff
719 ENDIF
720 IF(condnskyi(kk)>condnskyi(k))THEN
721 ff = condnskyi(kk)
722 condnskyi(kk) = condnskyi(k)
723 condnskyi(k) = ff
724 ENDIF
725 ENDDO
726 ENDDO
727 ELSE
728 DO k=jj1,jj2-1
729 DO kk=k+1,jj2
730 DO l=1,nfskyi
731 IF(fskyi(kk,l)>fskyi(k,l))THEN
732 ff = fskyi(kk,l)
733 fskyi(kk,l) = fskyi(k,l)
734 fskyi(k,l) = ff
735 ENDIF
736 ENDDO
737 IF(ftheskyi(kk)>ftheskyi(k))THEN
738 ff = ftheskyi(kk)
739 ftheskyi(kk) = ftheskyi(k)
740 ftheskyi(k) = ff
741 ENDIF
742 ENDDO
743 ENDDO
744 ENDIF
745 ENDIF
746C
747 IF(intplyxfem > 0 ) THEN
748 DO k=jj1,jj2-1
749 DO kk=k+1,jj2
750 IF(plyskyi%FSKYI(k,5) == plyskyi%FSKYI(kk,5)) THEN
751 DO l=1,4
752 IF(plyskyi%FSKYI(kk,l)>plyskyi%FSKYI(k,l))THEN
753 ff = plyskyi%FSKYI(kk,l)
754 plyskyi%FSKYI(kk,l) = plyskyi%FSKYI(k,l)
755 plyskyi%FSKYI(k,l) = ff
756 ENDIF
757 ENDDO
758 ENDIF
759 ENDDO
760 ENDDO
761 ENDIF
762C
763C-----------------------------------------------
764C ASSEMBLAGE DES FORCES
765C-----------------------------------------------
766
767 IF(glob_therm%INTHEAT == 0 ) THEN
768 IF(kdtint==0)THEN
769 DO k=jj1,jj2
770 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
771 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
772 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
773 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
774 ENDDO
775 ELSE
776 DO k=jj1,jj2
777 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
778 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
779 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
780 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
781 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
782 ENDDO
783 ENDIF
784C+ la thermique
785 ELSE
786 IF(glob_therm%NODADT_THERM == 1) THEN
787 IF(kdtint==0)THEN
788 DO k=jj1,jj2
789 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
790 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
791 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
792 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
793 fthe(n) = fthe(n) + ftheskyi(k)
794 condn(n) = condn(n)+ condnskyi(k)
795 ftheskyi(k) = zero
796 ENDDO
797 ELSE
798 DO k=jj1,jj2
799 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
800 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
801 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
802 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
803 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
804 fthe(n) = fthe(n) + ftheskyi(k)
805 condn(n) = condn(n)+ condnskyi(k)
806 ftheskyi(k) = zero
807 ENDDO
808 ENDIF
809 ELSE
810 IF(kdtint==0)THEN
811 DO k=jj1,jj2
812 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
813 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
814 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
815 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
816 fthe(n) = fthe(n) + ftheskyi(k)
817 ftheskyi(k) = zero
818 ENDDO
819 ELSE
820 DO k=jj1,jj2
821 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
822 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
823 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
824 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
825 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
826 fthe(n) = fthe(n) + ftheskyi(k)
827 ftheskyi(k) = zero
828 ENDDO
829 ENDIF
830 ENDIF
831
832 ENDIF
833C
834C for plyxfem node
835C
836
837 IF(intplyxfem > 0) THEN
838 DO k=jj1,jj2
839 il = inod_pxfem(n)
840 IF(il > 0) THEN
841C Iply is the position of ply in contact
842 iply = int(plyskyi%FSKYI(k,5))
843 IF(iply > 0) THEN
844 ply(iply)%A(1,il)=ply(iply)%A(1,il)+ plyskyi%FSKYI(k,1)
845 ply(iply)%A(2,il)=ply(iply)%A(2,il)+ plyskyi%FSKYI(k,2)
846 ply(iply)%A(3,il)=ply(iply)%A(3,il)+ plyskyi%FSKYI(k,3)
847 ply(iply)%A(4,il)=ply(iply)%A(4,il)+ plyskyi%FSKYI(k,4)
848 ENDIF
849 ENDIF
850 ENDDO
851 ENDIF
852C
853
854C
855 800 CONTINUE
856 ELSE
857
858 ENDIF
859C FIN NOUVEAUX TRAITEMENTS VECTORIELS
860C
861C plus de 20 contributions
862C
863 DO ijk=1,k3
864 n = vind3(ijk)
865 nn = n-1
866 jj1 = adskyi(nn)
867 jj2 = adskyi(n)-1
868C-----------------------------------------------
869C TRI DES FORCES D'INTERFACES (QSORT)
870C-----------------------------------------------
871 CALL ass2sort(fskyi,jj1,jj2,fskyt,nfskyi)
872 IF(glob_therm%INTHEAT > 0) CALL ass2sort(ftheskyi,jj1,jj2,fskyt,1)
873 IF(glob_therm%NODADT_THERM == 1) CALL ass2sort(condnskyi,jj1,jj2,fskyt,1)
874 IF(intplyxfem>0)
875 . CALL ass2sort_pxfem(plyskyi%FSKYI,jj1,jj2,fskyt,5)
876C-----------------------------------------------
877C ASSEMBLAGE DES FORCES
878C-----------------------------------------------
879 IF(glob_therm%INTHEAT == 0 ) THEN
880 IF(kdtint==0)THEN
881 DO k=jj1,jj2
882 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
883 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
884 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
885 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
886 ENDDO
887 ELSE
888 DO k=jj1,jj2
889 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
890 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
891 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
892 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
893 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
894 ENDDO
895 ENDIF
896C + la thermique
897 ELSE
898 IF(glob_therm%NODADT_THERM ==1) THEN
899 IF(kdtint==0)THEN
900 DO k=jj1,jj2
901 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
902 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
903 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
904 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
905 fthe(n) = fthe(n) + ftheskyi(k)
906 condn(n)= condn(n) + condnskyi(k)
907 ftheskyi(k) = zero
908 ENDDO
909 ELSE
910 DO k=jj1,jj2
911 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
912 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
913 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
914 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
915 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
916 fthe(n) = fthe(n) + ftheskyi(k)
917 condn(n)= condn(n) + condnskyi(k)
918 ftheskyi(k) = zero
919 ENDDO
920 ENDIF
921 ELSE
922 IF(kdtint==0)THEN
923 DO k=jj1,jj2
924 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
925 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
926 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
927 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
928 fthe(n) = fthe(n) + ftheskyi(k)
929 ftheskyi(k) = zero
930 ENDDO
931 ELSE
932 DO k=jj1,jj2
933 nodes%A(1,n) = nodes%A(1,n) + fskyi(k,1)
934 nodes%A(2,n) = nodes%A(2,n) + fskyi(k,2)
935 nodes%A(3,n) = nodes%A(3,n) + fskyi(k,3)
936 nodes%STIFN(n) = nodes%STIFN(n) + fskyi(k,4)
937 nodes%VISCN(n) = nodes%VISCN(n) + fskyi(k,5)
938 fthe(n) = fthe(n) + ftheskyi(k)
939 ftheskyi(k) = zero
940 ENDDO
941 ENDIF
942 ENDIF
943 ENDIF
944C type 24 + plyxfem
945 IF(intplyxfem > 0) THEN
946 DO k=jj1,jj2
947 il = inod_pxfem(n)
948 IF(il > 0 ) THEN
949 iply = int(plyskyi%FSKYI(k,5))
950 IF(iply > 0) THEN
951 ply(iply)%A(1,il)=ply(iply)%A(1,il) + plyskyi%FSKYI(k,1)
952 ply(iply)%A(2,il)=ply(iply)%A(2,il) + plyskyi%FSKYI(k,2)
953 ply(iply)%A(3,il)=ply(iply)%A(3,il) + plyskyi%FSKYI(k,3)
954 ply(iply)%A(4,il)=ply(iply)%A(4,il) + plyskyi%FSKYI(k,4)
955 ENDIF
956 ENDIF
957 ENDDO
958 ENDIF
959C
960 ENDDO
961 ENDDO
962!$omp END DO
963c ftheskyi and condnskyi are nor all reset to zero
964c
965C fin nisky/=0
966 ENDIF
967C
968 num7 = npsav*npart
969C
970 km = 0
971 DO k=1,nthread-1
972 km = km + num7
973#include "vectorize.inc"
974 DO i=partft,partlt
975 partsav(i) = partsav(i) + partsav(i+km)
976 partsav(i+km) = zero
977 END DO
978 END DO
979C
980 CALL my_barrier
981C
982 num7 = npsav*ngpe
983C
984 km = 0
985 IF (nthpart > 0) THEN
986 DO k=1,nthread-1
987 km = km + num7
988#include "vectorize.inc"
989 DO i=greft,grelt
990 gresav(i) = gresav(i) + gresav(i+km)
991 gresav(i+km) = zero
992 ENDDO
993 ENDDO
994 ENDIF
995 CALL my_barrier
996C-----------------------------------------------
997C
998 DEALLOCATE(vind1)
999 DEALLOCATE(vind2)
1000 DEALLOCATE(vind3)
1001
1002 RETURN
ass2sort
subroutine ass2sort(fskyi, jj1, jj2, fskyt, nfsk)
Definition ass2sort.F:34
ass2sort_pxfem
subroutine ass2sort_pxfem(fskyi, jj1, jj2, fskyt, nfsk)
Definition ass2sort.F:88
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::ply
type(ply_data), dimension(:), allocatable ply
Definition plyxfem_mod.F:91
plyxfem_mod::plysky
type(ply_data), dimension(:), allocatable plysky
Definition plyxfem_mod.F:91
plyxfem_mod::plyskyi
type(ply_data), allocatable plyskyi
Definition plyxfem_mod.F:92
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ asspari2()

subroutine asspari2 ( a,
ar,
stifn,
stifr,
ms,
in,
fskyi2,
integer i2size,
integer, dimension(*) addcni2,
integer, dimension(*) indsky,
ftheskyi2,
fthe,
condnskyi2,
condn,
type (glob_therm_), intent(inout) glob_therm )

Definition at line 1012 of file asspar4.F.

1016C-----------------------------------------------
1017C M o d u l e s
1018C-----------------------------------------------
1019 use glob_therm_mod
1020C-----------------------------------------------
1021C I m p l i c i t T y p e s
1022C-----------------------------------------------
1023#include "implicit_f.inc"
1024C-----------------------------------------------
1025C C o m m o n B l o c k s
1026C-----------------------------------------------
1027#include "com01_c.inc"
1028#include "com04_c.inc"
1029#include "parit_c.inc"
1030#include "scr18_c.inc"
1031 INTEGER MAXBLOCI2,NBLOCI2,NBVALI2,NBCOLI2
1032 parameter(maxbloci2=1000)
1033 common/ptmpari2/nbloci2,nbvali2(1:maxbloci2),nbcoli2(1:maxbloci2)
1034C-----------------------------------------------
1035C D u m m y A r g u m e n t s
1036C-----------------------------------------------
1037 INTEGER I2SIZE, ADDCNI2(*),INDSKY(*)
1038C REAL
1039 my_real
1040 . a(3,*) ,ar(3,*), stifn(*), stifr(*), ms(*), in(*),
1041 . fskyi2(i2size,*),ftheskyi2(*),fthe(*),condnskyi2(*),condn(*)
1042 type (glob_therm_) ,intent(inout) :: glob_therm
1043C-----------------------------------------------
1044C L o c a l V a r i a b l e s
1045C-----------------------------------------------
1046 INTEGER K,N,NC,NCT,IDEB,LB,KK,K1,K2
1047C-----------------------------------------------
1048C Interface type2
1049C-----------------------------------------------
1050 IF (ivector==1) THEN
1051C
1052 ELSE
1053C
1054C scalaire
1055 IF(glob_therm%INTHEAT == 0 ) THEN
1056 IF(iroddl/=0)THEN
1057 DO n = 1, numnod
1058 nct = addcni2(n)-1
1059 nc = addcni2(n+1)-addcni2(n)
1060 DO k = nct+1, nct+nc
1061 a(1,n) = a(1,n) + fskyi2(1,k)
1062 a(2,n) = a(2,n) + fskyi2(2,k)
1063 a(3,n) = a(3,n) + fskyi2(3,k)
1064 ms(n) = ms(n) + fskyi2(4,k)
1065 stifn(n) = stifn(n) + fskyi2(5,k)
1066 ar(1,n) = ar(1,n) + fskyi2(6,k)
1067 ar(2,n) = ar(2,n) + fskyi2(7,k)
1068 ar(3,n) = ar(3,n) + fskyi2(8,k)
1069 in(n) = in(n) + fskyi2(9,k)
1070 stifr(n) = stifr(n) + fskyi2(10,k)
1071 ENDDO
1072 ENDDO
1073 ELSE
1074 DO n = 1, numnod
1075 nct = addcni2(n)-1
1076 nc = addcni2(n+1)-addcni2(n)
1077 DO k = nct+1, nct+nc
1078 a(1,n) = a(1,n) + fskyi2(1,k)
1079 a(2,n) = a(2,n) + fskyi2(2,k)
1080 a(3,n) = a(3,n) + fskyi2(3,k)
1081 ms(n) = ms(n) + fskyi2(4,k)
1082 stifn(n) = stifn(n) + fskyi2(5,k)
1083 ENDDO
1084 ENDDO
1085 ENDIF
1086 ELSE
1087 IF(iroddl/=0)THEN
1088 DO n = 1, numnod
1089 nct = addcni2(n)-1
1090 nc = addcni2(n+1)-addcni2(n)
1091 DO k = nct+1, nct+nc
1092 a(1,n) = a(1,n) + fskyi2(1,k)
1093 a(2,n) = a(2,n) + fskyi2(2,k)
1094 a(3,n) = a(3,n) + fskyi2(3,k)
1095 ms(n) = ms(n) + fskyi2(4,k)
1096 stifn(n) = stifn(n) + fskyi2(5,k)
1097 ar(1,n) = ar(1,n) + fskyi2(6,k)
1098 ar(2,n) = ar(2,n) + fskyi2(7,k)
1099 ar(3,n) = ar(3,n) + fskyi2(8,k)
1100 in(n) = in(n) + fskyi2(9,k)
1101 stifr(n) = stifr(n) + fskyi2(10,k)
1102 fthe(n) = fthe(n) + ftheskyi2(k)
1103 ENDDO
1104 ENDDO
1105 ELSE
1106 DO n = 1, numnod
1107 nct = addcni2(n)-1
1108 nc = addcni2(n+1)-addcni2(n)
1109 DO k = nct+1, nct+nc
1110 a(1,n) = a(1,n) + fskyi2(1,k)
1111 a(2,n) = a(2,n) + fskyi2(2,k)
1112 a(3,n) = a(3,n) + fskyi2(3,k)
1113 ms(n) = ms(n) + fskyi2(4,k)
1114 stifn(n) = stifn(n) + fskyi2(5,k)
1115 fthe(n) = fthe(n) + ftheskyi2(k)
1116 ENDDO
1117 ENDDO
1118 ENDIF
1119 ENDIF
1120
1121 ENDIF
1122C-----------------------------------------------
1123C
1124 RETURN