OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
asspar.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| asspar ../engine/source/assembly/asspar.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- uses -----------------------------------------------------
28!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
29!||====================================================================
30 SUBROUTINE asspar(NTHREAD ,NUMNOD,NODFT ,NODLT,IRODDL,
31 . NPART,PARTFT ,PARTLT,A ,AR ,
32 . PARTSAV,STIFN ,STIFR,VISCN ,
33 . FTHE ,ITHERM_FE ,NODADT_THERM,STCND,GREFT,GRELT ,
34 . GRESAV,NGPE ,NTHPART,IALELAG,AF,
35 . DMSPH ,CONDN,APINCH,STIFPINCH)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE pinchtype_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "param_c.inc"
48#include "remesh_c.inc"
49#include "scr18_c.inc"
50#include "sphcom.inc"
51C
52C-----------------------------------------------------------------------
53 INTEGER :: NODADT_THERM
54 INTEGER :: ITHERM_FE
55 INTEGER NTHREAD,NUMNOD,NODFT,NODLT,IRODDL,
56 . NPART,PARTFT,PARTLT,GREFT,GRELT,NGPE,
57 . NTHPART,IALELAG
58 INTEGER K,KN,IKN,IKN1,IKN2,I,KM,KM1,KM2,NUM7,NUM8,KM3,KM4,KM5
59 my_real
60 . a(3,*),ar(3,*),partsav(*),stifn(*),stifr(*),viscn(*),
61 . fthe(*), stcnd(*),gresav(*),af(3,*), dmsph(*),condn(*)
62 my_real
63 . apinch(3,*),stifpinch(*)
64C-----------------------------------------------------------------------
65 num7 = npsav*npart
66 num8 = npsav*ngpe
67C
68 GOTO(100,200,300)nthread-1
69 GOTO 900
70C------------
71C 2 TASKS
72 100 CONTINUE
73#include "vectorize.inc"
74 DO 120 i=nodft,nodlt
75 ikn = i+ numnod
76 stifn(i) = stifn(i) + stifn(ikn)
77 stifn(ikn) = zero
78 a(1,i) = a(1,i) + a(1,ikn)
79 a(2,i) = a(2,i) + a(2,ikn)
80 a(3,i) = a(3,i) + a(3,ikn)
81 a(1,ikn) = zero
82 a(2,ikn) = zero
83 a(3,ikn) = zero
84 120 CONTINUE
85
86 IF(npinch > 0) THEN
87#include "vectorize.inc"
88 DO i=nodft,nodlt
89 ikn = i+ numnod
90 stifpinch(i) = stifpinch(i) + stifpinch(ikn)
91 stifpinch(ikn) = zero
92 apinch(1,i) = apinch(1,i) + apinch(1,ikn)
93 apinch(2,i) = apinch(2,i) + apinch(2,ikn)
94 apinch(3,i) = apinch(3,i) + apinch(3,ikn)
95 apinch(1,ikn) = zero
96 apinch(2,ikn) = zero
97 apinch(3,ikn) = zero
98 ENDDO
99 ENDIF
100
101 IF (iroddl/=0) THEN
102#include "vectorize.inc"
103 DO 140 i=nodft,nodlt
104 ikn = i + numnod
105 stifr(i) = stifr(i) + stifr(ikn)
106 stifr(ikn) = zero
107 ar(1,i) = ar(1,i) + ar(1,ikn)
108 ar(2,i) = ar(2,i) + ar(2,ikn)
109 ar(3,i) = ar(3,i) + ar(3,ikn)
110 ar(1,ikn) = zero
111 ar(2,ikn) = zero
112 ar(3,ikn) = zero
113 140 CONTINUE
114 ENDIF
115C
116 IF(itherm_fe > 0 ) THEN
117#include "vectorize.inc"
118 DO i=nodft,nodlt
119 ikn = i+ numnod
120 fthe(i) = fthe(i) + fthe(ikn)
121 fthe(ikn) = zero
122 ENDDO
123 ENDIF
124C
125 IF(nodadt_therm > 0 ) THEN
126#include "vectorize.inc"
127 DO i=nodft,nodlt
128 ikn = i+ numnod
129 condn(i) = condn(i) + condn(ikn)
130 condn(ikn) = zero
131 ENDDO
132 ENDIF
133C
134 IF(istatcnd /=0) THEN
135 DO i=nodft,nodlt
136 ikn = i+ numnod
137 stcnd(i) = stcnd(i) + stcnd(ikn)
138 stcnd(ikn) = zero
139 ENDDO
140 ENDIF
141C
142 IF(ialelag> 0) THEN
143#include "vectorize.inc"
144 DO i=nodft,nodlt
145 ikn = i+ numnod
146 af(1,i) = af(1,i) + af(1,ikn)
147 af(2,i) = af(2,i) + af(2,ikn)
148 af(3,i) = af(3,i) + af(3,ikn)
149 af(1,ikn) = zero
150 af(2,ikn) = zero
151 af(3,ikn) = zero
152 ENDDO
153 ENDIF
154
155C viscosite
156 IF(kdtint/=0)THEN
157#include "vectorize.inc"
158 DO i=nodft,nodlt
159 ikn = i + numnod
160 viscn(i) = viscn(i) + viscn(ikn)
161 viscn(ikn) = zero
162 ENDDO
163 ENDIF
164C
165 IF(sol2sph_flag /=0) THEN
166#include "vectorize.inc"
167 DO i=nodft,nodlt
168 ikn = i+ numnod
169 dmsph(i) = dmsph(i) + dmsph(ikn)
170 dmsph(ikn) = zero
171 ENDDO
172 ENDIF
173C
174#include "vectorize.inc"
175 DO 160 i=partft,partlt
176 partsav(i) = partsav(i) + partsav(i+num7)
177 partsav(i+num7) = zero
178 160 CONTINUE
179 GOTO 1000
180C------------
181C 3 TASKS
182 200 CONTINUE
183#include "vectorize.inc"
184 DO 220 i=nodft,nodlt
185 ikn = i + numnod
186 ikn1 = ikn + numnod
187 stifn(i) = stifn(i) + stifn(ikn) + stifn(ikn1)
188 stifn(ikn) = zero
189 stifn(ikn1) = zero
190 a(1,i) = a(1,i) + a(1,ikn) + a(1,ikn1)
191 a(2,i) = a(2,i) + a(2,ikn) + a(2,ikn1)
192 a(3,i) = a(3,i) + a(3,ikn) + a(3,ikn1)
193 a(1,ikn) = zero
194 a(2,ikn) = zero
195 a(3,ikn) = zero
196 a(1,ikn1) = zero
197 a(2,ikn1) = zero
198 a(3,ikn1) = zero
199 220 CONTINUE
200
201 IF(npinch > 0) THEN
202#include "vectorize.inc"
203 DO i=nodft,nodlt
204 ikn = i + numnod
205 ikn1 = ikn + numnod
206 stifpinch(i) = stifpinch(i) + stifpinch(ikn) + stifpinch(ikn1)
207 stifpinch(ikn) = zero
208 stifpinch(ikn1) = zero
209 apinch(1,i) = apinch(1,i) + apinch(1,ikn) + apinch(1,ikn1)
210 apinch(2,i) = apinch(2,i) + apinch(2,ikn) + apinch(2,ikn1)
211 apinch(3,i) = apinch(3,i) + apinch(3,ikn) + apinch(3,ikn1)
212 apinch(1,ikn) = zero
213 apinch(2,ikn) = zero
214 apinch(3,ikn) = zero
215 apinch(1,ikn1) = zero
216 apinch(2,ikn1) = zero
217 apinch(3,ikn1) = zero
218 ENDDO
219 ENDIF
220
221
222 IF (iroddl/=0) THEN
223#include "vectorize.inc"
224 DO 240 i=nodft,nodlt
225 ikn = i + numnod
226 ikn1 = ikn + numnod
227 stifr(i) = stifr(i) + stifr(ikn) + stifr(ikn1)
228 stifr(ikn) = zero
229 stifr(ikn1) = zero
230 ar(1,i) = ar(1,i) + ar(1,ikn) + ar(1,ikn1)
231 ar(2,i) = ar(2,i) + ar(2,ikn) + ar(2,ikn1)
232 ar(3,i) = ar(3,i) + ar(3,ikn) + ar(3,ikn1)
233 ar(1,ikn) = zero
234 ar(2,ikn) = zero
235 ar(3,ikn) = zero
236 ar(1,ikn1) = zero
237 ar(2,ikn1) = zero
238 ar(3,ikn1) = zero
239 240 CONTINUE
240 ENDIF
241C
242 IF(itherm_fe > 0 ) THEN
243#include "vectorize.inc"
244 DO i=nodft,nodlt
245 ikn = i + numnod
246 ikn1 = ikn + numnod
247 fthe(i) = fthe(i) + fthe(ikn) + fthe(ikn1)
248 fthe(ikn) = zero
249 fthe(ikn1) = zero
250 ENDDO
251 ENDIF
252C
253 IF(nodadt_therm > 0 ) THEN
254#include "vectorize.inc"
255 DO i=nodft,nodlt
256 ikn = i + numnod
257 ikn1 = ikn + numnod
258 condn(i) = condn(i) + condn(ikn) + condn(ikn1)
259 condn(ikn) = zero
260 condn(ikn1) = zero
261 ENDDO
262 ENDIF
263C
264 IF(istatcnd /=0) THEN
265 DO i=nodft,nodlt
266 ikn = i+ numnod
267 ikn1 = ikn + numnod
268 stcnd(i) = stcnd(i) + stcnd(ikn) + stcnd(ikn1)
269 stcnd(ikn) = zero
270 stcnd(ikn1) = zero
271 ENDDO
272 ENDIF
273C
274C viscosite
275 IF(kdtint/=0)THEN
276#include "vectorize.inc"
277 DO i=nodft,nodlt
278 ikn = i + numnod
279 ikn1 = ikn + numnod
280 viscn(i) = viscn(i) + viscn(ikn) + viscn(ikn1)
281 viscn(ikn) = zero
282 viscn(ikn1) = zero
283 ENDDO
284 ENDIF
285 IF(ialelag > 0) THEN
286#include "vectorize.inc"
287 DO i=nodft,nodlt
288 ikn = i + numnod
289 ikn1 = ikn + numnod
290C
291 af(1,i) = af(1,i) + af(1,ikn) + af(1,ikn1)
292 af(2,i) = af(2,i) + af(2,ikn) + af(2,ikn1)
293 af(3,i) = af(3,i) + af(3,ikn) + af(3,ikn1)
294 af(1,ikn) = zero
295 af(2,ikn) = zero
296 af(3,ikn) = zero
297 af(1,ikn1) = zero
298 af(2,ikn1) = zero
299 af(3,ikn1) = zero
300 ENDDO
301 ENDIF
302C
303 IF(sol2sph_flag /=0) THEN
304#include "vectorize.inc"
305 DO i=nodft,nodlt
306 ikn = i+ numnod
307 ikn1 = ikn + numnod
308 dmsph(i) = dmsph(i) + dmsph(ikn) + dmsph(ikn1)
309 dmsph(ikn) = zero
310 dmsph(ikn1) = zero
311 ENDDO
312 ENDIF
313C
314 km = num7
315 km1 = num7 + num7
316#include "vectorize.inc"
317 DO 260 i=partft,partlt
318 partsav(i) = partsav(i) + partsav(i+km) + partsav(i+km1)
319 partsav(i+km) = zero
320 partsav(i+km1) = zero
321 260 CONTINUE
322 km3 = num8
323 km4 = num8 + num8
324 IF (nthpart > 0) THEN
325#include "vectorize.inc"
326 DO 270 i=greft,grelt
327 gresav(i) = gresav(i) + gresav(i+km3) + gresav(i+km4)
328 gresav(i+km3) = zero
329 gresav(i+km4) = zero
330 270 CONTINUE
331 ENDIF
332 GOTO 1000
333C------------
334C 4 TASKS
335 300 CONTINUE
336#include "vectorize.inc"
337 DO 320 i=nodft,nodlt
338 ikn = i + numnod
339 ikn1 = ikn + numnod
340 ikn2 = ikn1 + numnod
341 stifn(i) = stifn(i) + stifn(ikn) +
342 . stifn(ikn1) + stifn(ikn2)
343 stifn(ikn) = zero
344 stifn(ikn1) = zero
345 stifn(ikn2) = zero
346 a(1,i) = a(1,i) + a(1,ikn) + a(1,ikn1) + a(1,ikn2)
347 a(2,i) = a(2,i) + a(2,ikn) + a(2,ikn1) + a(2,ikn2)
348 a(3,i) = a(3,i) + a(3,ikn) + a(3,ikn1) + a(3,ikn2)
349 a(1,ikn) = zero
350 a(2,ikn) = zero
351 a(3,ikn) = zero
352 a(1,ikn1) = zero
353 a(2,ikn1) = zero
354 a(3,ikn1) = zero
355 a(1,ikn2) = zero
356 a(2,ikn2) = zero
357 a(3,ikn2) = zero
358 320 CONTINUE
359
360 IF(npinch > 0) THEN
361#include "vectorize.inc"
362 DO i=nodft,nodlt
363 ikn = i + numnod
364 ikn1 = ikn + numnod
365 ikn2 = ikn1 + numnod
366 stifpinch(i) = stifpinch(i) + stifpinch(ikn) + stifpinch(ikn1) + stifpinch(ikn2)
367 stifpinch(ikn) = zero
368 stifpinch(ikn1) = zero
369 stifpinch(ikn2) = zero
370 apinch(1,i) = apinch(1,i) + apinch(1,ikn) + apinch(1,ikn1) + apinch(1,ikn2)
371 apinch(2,i) = apinch(2,i) + apinch(2,ikn) + apinch(2,ikn1) + apinch(2,ikn2)
372 apinch(3,i) = apinch(3,i) + apinch(3,ikn) + apinch(3,ikn1) + apinch(3,ikn2)
373 apinch(1,ikn) = zero
374 apinch(2,ikn) = zero
375 apinch(3,ikn) = zero
376 apinch(1,ikn1) = zero
377 apinch(2,ikn1) = zero
378 apinch(3,ikn1) = zero
379 apinch(1,ikn2) = zero
380 apinch(2,ikn2) = zero
381 apinch(3,ikn2) = zero
382 ENDDO
383 ENDIF
384
385 IF (iroddl/=0) THEN
386#include "vectorize.inc"
387 DO 340 i=nodft,nodlt
388 ikn = i + numnod
389 ikn1 = ikn + numnod
390 ikn2 = ikn1 + numnod
391 stifr(i) = stifr(i) + stifr(ikn) +
392 . stifr(ikn1) + stifr(ikn2)
393 stifr(ikn) = zero
394 stifr(ikn1) = zero
395 stifr(ikn2) = zero
396 ar(1,i) = ar(1,i) + ar(1,ikn) + ar(1,ikn1) + ar(1,ikn2)
397 ar(2,i) = ar(2,i) + ar(2,ikn) + ar(2,ikn1) + ar(2,ikn2)
398 ar(3,i) = ar(3,i) + ar(3,ikn) + ar(3,ikn1) + ar(3,ikn2)
399 ar(1,ikn) = zero
400 ar(2,ikn) = zero
401 ar(3,ikn) = zero
402 ar(1,ikn1) = zero
403 ar(2,ikn1) = zero
404 ar(3,ikn1) = zero
405 ar(1,ikn2) = zero
406 ar(2,ikn2) = zero
407 ar(3,ikn2) = zero
408 340 CONTINUE
409 ENDIF
410C
411 IF(itherm_fe > 0 ) THEN
412#include "vectorize.inc"
413 DO i=nodft,nodlt
414 ikn = i + numnod
415 ikn1 = ikn + numnod
416 ikn2 = ikn1 + numnod
417 fthe(i) = fthe(i) + fthe(ikn) + fthe(ikn1) + fthe(ikn2)
418 fthe(ikn) = zero
419 fthe(ikn1) = zero
420 fthe(ikn2) = zero
421 ENDDO
422 ENDIF
423C
424 IF(nodadt_therm > 0 ) THEN
425#include "vectorize.inc"
426 DO i=nodft,nodlt
427 ikn = i + numnod
428 ikn1 = ikn + numnod
429 ikn2 = ikn1 + numnod
430 condn(i) = condn(i) + condn(ikn) + condn(ikn1) + condn(ikn2)
431 condn(ikn) = zero
432 condn(ikn1) = zero
433 condn(ikn2) = zero
434 ENDDO
435 ENDIF
436C
437 IF(istatcnd /=0) THEN
438 DO i=nodft,nodlt
439 ikn = i+ numnod
440 ikn1 = ikn + numnod
441 ikn2 = ikn1 + numnod
442 stcnd(i) = stcnd(i) + stcnd(ikn) + stcnd(ikn1) + stcnd(ikn2)
443 stcnd(ikn) = zero
444 stcnd(ikn1) = zero
445 stcnd(ikn2) = zero
446 ENDDO
447 ENDIF
448C
449 IF(ialelag > 0) THEN
450#include "vectorize.inc"
451 DO i=nodft,nodlt
452 ikn = i + numnod
453 ikn1 = ikn + numnod
454 ikn2 = ikn1 + numnod
455C
456 a(1,i) = a(1,i) + a(1,ikn) + a(1,ikn1) + a(1,ikn2)
457 a(2,i) = a(2,i) + a(2,ikn) + a(2,ikn1) + a(2,ikn2)
458 a(3,i) = a(3,i) + a(3,ikn) + a(3,ikn1) + a(3,ikn2)
459 a(1,ikn) = zero
460 a(2,ikn) = zero
461 a(3,ikn) = zero
462 a(1,ikn1) = zero
463 a(2,ikn1) = zero
464 a(3,ikn1) = zero
465 a(1,ikn2) = zero
466 a(2,ikn2) = zero
467 a(3,ikn2) = zero
468 ENDDO
469 ENDIF
470C
471C viscosite
472 IF(kdtint/=0)THEN
473#include "vectorize.inc"
474 DO i=nodft,nodlt
475 ikn = i + numnod
476 ikn1 = ikn + numnod
477 ikn2 = ikn1 + numnod
478 viscn(i) = viscn(i) + viscn(ikn) +
479 . viscn(ikn1) + viscn(ikn2)
480 viscn(ikn) = zero
481 viscn(ikn1) = zero
482 viscn(ikn2) = zero
483 ENDDO
484 ENDIF
485C
486 IF(sol2sph_flag /=0) THEN
487#include "vectorize.inc"
488 DO i=nodft,nodlt
489 ikn = i+ numnod
490 ikn1 = ikn + numnod
491 ikn2 = ikn1 + numnod
492 dmsph(i) = dmsph(i) + dmsph(ikn) + dmsph(ikn1) + dmsph(ikn2)
493 dmsph(ikn) = zero
494 dmsph(ikn1) = zero
495 dmsph(ikn2) = zero
496 ENDDO
497 ENDIF
498C
499 km = num7
500 km1 = km + num7
501 km2 = km1 + num7
502#include "vectorize.inc"
503 DO 360 i=partft,partlt
504 partsav(i) = partsav(i) + partsav(i+km) +
505 . partsav(i+km1) + partsav(i+km2)
506 partsav(i+km) = zero
507 partsav(i+km1) = zero
508 partsav(i+km2) = zero
509 360 CONTINUE
510 km3 = num8
511 km4 = km3 + num8
512 km5 = km4 + num8
513 IF (nthpart > 0) THEN
514#include "vectorize.inc"
515 DO 370 i=greft,grelt
516 gresav(i) = gresav(i) + gresav(i+km3) +
517 . gresav(i+km4) + gresav(i+km5)
518 gresav(i+km3) = zero
519 gresav(i+km4) = zero
520 gresav(i+km5) = zero
521 370 CONTINUE
522 ENDIF
523 GOTO 1000
524C------------
525C NTHREADS > 4
526 900 CONTINUE
527 kn = 0
528 km = 0
529 km3 = 0
530 DO 950 k=1,nthread-1
531 kn = kn + numnod
532#include "vectorize.inc"
533 DO 930 i=nodft,nodlt
534 ikn = i+kn
535 stifn(i) = stifn(i) + stifn(ikn)
536 stifn(ikn) = zero
537 a(1,i) = a(1,i) + a(1,ikn)
538 a(2,i) = a(2,i) + a(2,ikn)
539 a(3,i) = a(3,i) + a(3,ikn)
540 a(1,ikn) = zero
541 a(2,ikn) = zero
542 a(3,ikn) = zero
543 930 CONTINUE
544
545 IF (npinch > 0) THEN
546#include "vectorize.inc"
547 DO i=nodft,nodlt
548 ikn = i+kn
549 stifpinch(i) = stifpinch(i) + stifpinch(ikn)
550 stifpinch(ikn) = zero
551 apinch(1,i) = apinch(1,i) + apinch(1,ikn)
552 apinch(2,i) = apinch(2,i) + apinch(2,ikn)
553 apinch(3,i) = apinch(3,i) + apinch(3,ikn)
554 apinch(1,ikn) = zero
555 apinch(2,ikn) = zero
556 apinch(3,ikn) = zero
557 ENDDO
558 ENDIF
559
560 IF (iroddl/=0) THEN
561#include "vectorize.inc"
562 DO 935 i=nodft,nodlt
563 ikn = i+kn
564 stifr(i) = stifr(i) + stifr(ikn)
565 stifr(ikn) = zero
566 ar(1,i) = ar(1,i) + ar(1,ikn)
567 ar(2,i) = ar(2,i) + ar(2,ikn)
568 ar(3,i) = ar(3,i) + ar(3,ikn)
569 ar(1,ikn) = zero
570 ar(2,ikn) = zero
571 ar(3,ikn) = zero
572 935 CONTINUE
573 ENDIF
574C
575 IF(itherm_fe > 0 ) THEN
576#include "vectorize.inc"
577 DO i=nodft,nodlt
578 ikn = i + kn
579 fthe(i) = fthe(i) + fthe(ikn)
580 fthe(ikn) = zero
581 ENDDO
582 ENDIF
583C
584 IF(nodadt_therm > 0 ) THEN
585#include "vectorize.inc"
586 DO i=nodft,nodlt
587 ikn = i + kn
588 condn(i) = condn(i) + condn(ikn)
589 condn(ikn) = zero
590 ENDDO
591 ENDIF
592C
593 IF(istatcnd /=0) THEN
594 DO i=nodft,nodlt
595 ikn = i + kn
596 stcnd(i) = stcnd(i) + stcnd(ikn)
597 stcnd(ikn) = zero
598 ENDDO
599 ENDIF
600C
601 IF(ialelag > 0) THEN
602#include "vectorize.inc"
603 DO i=nodft,nodlt
604 ikn = i+kn
605 af(1,i) = af(1,i) + af(1,ikn)
606 af(2,i) = af(2,i) + af(2,ikn)
607 af(3,i) = af(3,i) + af(3,ikn)
608 af(1,ikn) = zero
609 af(2,ikn) = zero
610 af(3,ikn) = zero
611 ENDDO
612 ENDIF
613C viscosite
614 IF(kdtint/=0)THEN
615#include "vectorize.inc"
616 DO i=nodft,nodlt
617 ikn = i+kn
618 viscn(i) = viscn(i) + viscn(ikn)
619 viscn(ikn) = zero
620 ENDDO
621 ENDIF
622C
623 IF(sol2sph_flag/=0)THEN
624#include "vectorize.inc"
625 DO i=nodft,nodlt
626 ikn = i+kn
627 dmsph(i) = dmsph(i) + dmsph(ikn)
628 dmsph(ikn) = zero
629 ENDDO
630 ENDIF
631C
632 km = km + num7
633#include "vectorize.inc"
634 DO 940 i=partft,partlt
635 partsav(i) = partsav(i) + partsav(i+km)
636 partsav(i+km) = zero
637 940 CONTINUE
638 km3 = km3 + num8
639 IF (nthpart > 0) THEN
640#include "vectorize.inc"
641 DO 960 i=greft,grelt
642 gresav(i) = gresav(i) + gresav(i+km3)
643 gresav(i+km3) = zero
644 960 CONTINUE
645 ENDIF
646 950 CONTINUE
647C
648 1000 CONTINUE
649 RETURN
650 END
asspar
subroutine asspar(nthread, numnod, nodft, nodlt, iroddl, npart, partft, partlt, a, ar, partsav, stifn, stifr, viscn, fthe, itherm_fe, nodadt_therm, stcnd, greft, grelt, gresav, ngpe, nthpart, ialelag, af, dmsph, condn, apinch, stifpinch)
Definition asspar.F:36
my_real
#define my_real
Definition cppsort.cpp:32
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::npinch
integer npinch
Definition pinchtype_mod.F:73