36 use element_mod , only : nixs,nixc,nixtg
37
38
39
40#include "implicit_f.inc"
41
42
43
44#include "spmd_c.inc"
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48#include "task_c.inc"
49
50
51
52 INTEGER NESBW,NSTRF(*),IXC(NIXC,*),IXTG(NIXTG,*),
53 . NODCUT,NPRW(*), IXS(NIXS,*),BUF,NODGLOB(*)
55 . x(3,*),rwbuf(nrwlp,*)
56
57
58
59 INTEGER J, JJ, LEN, I, K, L, KK, K0, K5, K9, N,
60 . N0, N1, N2, N3, N4, N10, NSEG, NSEGC, NSEGTG, ITYP,
61 . UNPACK(15,4), II(8), N5, N6, N7, N8, NSEGS, K3,OW,
62 . WA(6*BUF+4)
64 . xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
65 . xx4, yy4, zz4, d13, xxc, yyc, zzc
66 INTEGER POWER2(8),IPACK
67 INTEGER :: INDICE
68 INTEGER :: MODE,SIZE_BUFFER_S,SIZE_BUFFER00_R
69 INTEGER, DIMENSION(NSPMD) :: SHIFT_R,NB_ELEM_R
70 INTEGER, DIMENSION(NSECT,3,NSPMD) :: SHIFT_SECT
71 INTEGER, DIMENSION(NSECT+1,3) ::SINDEX
72 INTEGER, DIMENSION(NSECT+1,3,NSPMD) :: RINDEX_PROC
73 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFFER_S
74 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFFER00_R
75
76 DATA power2/1,2,4,8,16,32,64,128/
77
78 DATA unpack/1,2,1,3,1,2,1,4,1,2,1,3,1,2,1,
79 . 0,0,2,0,3,3,2,0,4,4,2,4,3,3,2,
80 . 0,0,0,0,0,0,3,0,0,0,4,0,4,4,3,
81 . 0,0,0,0,0,0,0,0,0,0,0,0,0,0,4/
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138! count
the number of
data
139
140 sindex(1:nsect+1,1:3) = 0
141 size_buffer00_r = 0
142 IF(ispmd==0) rindex_proc(1:nsect,1:3,1:nspmd) = 0
143 jj = 0
144
145 IF (nsect>0) THEN
146 k0 = nstrf(25)
147 DO i=1,nsect
148 n0 = numnod + nodcut + i - 1
149 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
150 1 + 2*nstrf(k0+7) +nstrf(k0+8)*2
151 nsegc = nstrf(k0+9)
152
153
154
155
156 DO j=1,nsegc
157 kk = k5+2*(j-1)
158 n = nstrf(kk)
159 IF(nstrf(kk+1)/=0) THEN
160 jj = jj + 4
161 ENDIF
162 ENDDO
163 sindex(i,1) = jj
164 k9 = k5+2*nstrf(k0+9) +2*nstrf(k0+10)
165 1 +2*nstrf(k0+11)+2*nstrf(k0+12)
166 nsegtg = nstrf(k0+13)
167
168
169
170 DO j=1,nsegtg
171 kk = k9+2*(j-1)
172 n = nstrf(kk)
173 IF(nstrf(kk+1)/=0) THEN
174
175 ENDIF
176 ENDDO
177 sindex(i,2) = jj
178
179 k3=k0+30+nstrf(k0+14)+nstrf(k0+6)
180 nsegs=nstrf(k0+7)
181
182
183
184
185 IF(nsegs/=0)THEN
186 jj = jj + 4
187 END IF
188 DO j=1,nsegs
189 kk=k3+2*(j-1)
190 ipack=nstrf(kk+1)
191 IF(ipack/=0)THEN
192 n =nstrf(kk)
193 IF (nspmd == 1) THEN
194 ii(1)=ixs(2,n)-1
195 ii(2)=ixs(3,n)-1
196 ii(3)=ixs(4,n)-1
197 ii(4)=ixs(5,n)-1
198 ii(5)=ixs(6,n)-1
199 ii(6)=ixs(7,n)-1
200 ii(7)=ixs(8,n)-1
201 ii(8)=ixs(9,n)-1
202 ELSE
203 ii(1)=nodglob(ixs(2,n))-1
204 ii(2)=nodglob(ixs(3,n))-1
205 ii(3)=nodglob(ixs(4,n))-1
206 ii(4)=nodglob(ixs(5,n))-1
207 ii(5)=nodglob(ixs(6,n))-1
208 ii(6)=nodglob(ixs(7,n))-1
209 ii(7)=nodglob(ixs(8,n))-1
210 ii(8)=nodglob(ixs(9,n))-1
211 ENDIF
212
213 IF( ii(2)==ii(1).AND.ii(4)==ii(3)
214 . .AND.ii(8)==ii(5).AND.ii(7)==ii(6))THEN
215
216 n1=mod(ipack/power2(1),2)
217 n2=mod(ipack/power2(3),2)
218 n3=mod(ipack/power2(5),2)
219 n4=mod(ipack
220 IF(n1/=0.AND.n2/=0.AND.n3/=0)THEN
221 jj=jj+4
222 END IF
223 IF(n1/=0.AND.n2/=0.AND.n4/=0)THEN
224 jj=jj+4
225 END IF
226 IF(n2/=0.AND.n3/=0.AND.n4/=0)THEN
227 jj=jj+4
228 END IF
229 IF(n3/=0.AND.n1/=0.AND.n4/=0)THEN
230
231 END IF
232 ELSE
233
234 n1=mod(ipack/power2(1),2)
235 n2=mod(ipack/power2(2),2)
236 n3=mod
237
238 n5=mod(ipack/power2(5)
239 n6=mod(ipack/power2(6),2)
240 n7=mod(ipack/power2(7),2)
241 n8=mod(ipack/power2(8),2)
242 IFTHEN
243 jj=jj+4
244 END IF
245 IF(n5/=0.AND.n6/=0.AND.n7/=0.AND.n8THEN
246 jj=jj+4
247 END IF
248 IF(n1/=0.AND.n5/=0.AND.n6/=0.AND.n2/=0)THEN
249 jj=jj+4
250 END IF
251 IF(n4/=0.AND.n8/=0.AND.n7/=0.AND.n3/=0)THEN
252 jj=jj+4
253 END IF
254 IF(n1/=0.AND.n4/=0.AND.n8/=0.AND.n5/=0)THEN
255 jj=jj+4
256 END IF
257 IF(n2/=0.AND.n3/=0.AND.n7/=0.AND.n6/=0)THEN
258 jj=jj
259 END IF
260 END IF
261 END IF
262 END DO
263 k0=nstrf(k0+24)
264 sindex(i,3) = jj
265 ENDDO
266
267 size_buffer_s = jj
268 sindex(nsect+1,1:3) = size_buffer_s
269
270
271
272
273 ALLOCATE( buffer_s(size_buffer_s) )
274 mode = 0
275
276 ALLOCATE( buffer00_r(0) )
277
278 IF(nspmd>1) THEN
279 CALL spmd_gather_wa(mode,size_buffer_s,size_buffer00_r,sindex,rindex_proc,
280 1 buffer_s,buffer00_r,shift_r,nb_elem_r)
281 ELSE
282 size_buffer00_r = size_buffer_s
283
284 shift_r(1) = 0
285 rindex_proc(1:nsect,1:3,1) = sindex(1:nsect,1:3)
286 ENDIF
287
288 IF(ispmd==0) THEN
289 DEALLOCATE( buffer00_r )
290 ALLOCATE( buffer00_r(size_buffer00_r) )
291 ENDIF
292
293
294
295
296 k0 = nstrf(25)
297 jj = 0
298 DO i=1,nsect
299 n0 = numnod + nodcut + i - 1
300 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
301 1 + 2*nstrf(k0+7) +nstrf(k0+8)*2
302 nsegc = nstrf(k0+9)
303
304 DO j=1,nsegc
305 kk = k5+2*(j-1)
306 n = nstrf(kk)
307 IF(nstrf(kk+1)/=0) THEN
308 n1 = unpack(nstrf(kk+1),1)
309 n2 = unpack(nstrf(kk+1),2)
310 IF(n2==0)THEN
311 n2 = n1
312 n3 = n1
313 ELSE
314 n3 = unpack(nstrf(kk+1),3)
315 IF(n3==0)n3 = n2
316 ENDIF
317 IF (nspmd == 1) THEN
318 buffer_s(jj+1) = n0
319 buffer_s(jj+2) = ixc(1+n1,n)-1
320 buffer_s(jj+3) = ixc(1+n2,n)-1
321 buffer_s(jj+4) = ixc(1+n3,n)-1
322 jj = jj + 4
323 ELSE
324 buffer_s(jj+1) = numnodg + nodcut + i - 1
325 buffer_s(jj+2) = nodglob(ixc
326 buffer_s(jj+3) = nodglob(ixc(1+n2,n))-1
327 buffer_s(jj+4) = nodglob(ixc(1+n3,n))-1
328 jj = jj + 4
329 ENDIF
330 ENDIF
331 ENDDO
332
333 k9=k5+2*nstrf(k0+9) +2*nstrf(k0+10)
334 1 + 2*nstrf(k0+11)+2*nstrf(k0+12)
335 nsegtg = nstrf(k0+13)
336 DO j=1,nsegtg
337 kk = k9+2*(j-1)
338 n = nstrf(kk)
339 IF(nstrf(kk+1)/=0) THEN
340 n1 = unpack(nstrf
341 n2 = unpack(nstrf(1+kk),2)
342 IF(n2==0)THEN
343 n2 = n1
344 n3 = n1
345 ELSE
346 n3 = unpack(nstrf(1+kk),3)
347 IF(n3==0)n3 = n2
348 ENDIF
349 IF (nspmd == 1) THEN
350 buffer_s(jj+1) = n0
351 buffer_s(jj+2) = ixtg(1+n1,n)-1
352 buffer_s(jj+3) = ixtg(1+n2,n)-1
353 buffer_s(jj+4) = ixtg(1+n3,n)-1
354 jj = jj + 4
355 ELSE
356 buffer_s(jj+1) = numnodg + nodcut + i - 1
357 buffer_s(jj+2) = nodglob(ixtg(1+n1,n))-1
358 buffer_s(jj+3) = nodglob(ixtg(1+n2,n))-1
359 buffer_s(jj+4) = nodglob(ixtg(1+n3,n))-1
360 jj = jj + 4
361 ENDIF
362 ENDIF
363 ENDDO
364
365 k3=k0+30+nstrf(k0+14)+nstrf(k0+6)
366 nsegs=nstrf(k0+7)
367
368 IF(nsegs/=0)THEN
369 IF (nspmd == 1) THEN
370 buffer_s(jj+1) = n0
371 buffer_s(jj+2) = n0
372 buffer_s(jj+3) = n0
373 buffer_s(jj+4) = n0
374 jj = jj + 4
375 ELSE
376 buffer_s(jj+1) = numnodg + nodcut + i - 1
377 buffer_s(jj+2) = numnodg + nodcut + i - 1
378 buffer_s(jj+3) = numnodg + nodcut
379 buffer_s(jj+4) = numnodg + nodcut + i - 1
380 jj = jj + 4
381 ENDIF
382 END IF
383
384 DO j=1,nsegs
385 kk=k3+2*(j-1)
386 ipack=nstrf(kk+1)
387 IF(ipack/=0)THEN
388 n =nstrf(kk)
389 IF (nspmd == 1) THEN
390 ii(1)=ixs(2,n)-1
391 ii(2)=ixs(3,n)-1
392 ii(3)=ixs(4,n)-1
393 ii(4)=ixs(5,n)-1
394 ii(5)=ixs(6,n)-1
395 ii(6)=ixs(7,n)-1
396 ii(7)=ixs(8,n)-1
397 ii(8)=ixs(9,n)-1
398 ELSE
399 ii(1)=nodglob(ixs(2,n))-1
400 ii(2)=nodglob(ixs(3,n))-1
401 ii(3)=nodglob(ixs(4,n))-1
402 ii(4)=nodglob(ixs(5,n))-1
403 ii(5)=nodglob(ixs(6,n))-1
404 ii(6)=nodglob(ixs(7,n))-1
405 ii(7)=nodglob(ixs(8,n))-1
406 ii(8)=nodglob(ixs(9,n))-1
407 ENDIF
408
409 IF( ii(2)==ii(1).AND.ii(4)==ii(3)
410 . .AND.ii(8)==ii(5).AND.ii(7)==ii(6))THEN
411
412 n1=mod(ipack/power2(1),2)
413 n2=mod(ipack/power2(3),2)
414 n3=mod(ipack/power2(5),2)
415 n4=mod(ipack/power2(6
416 IF(n1/=0.AND.n2/=0.AND.n3/=0)THEN
417 buffer_s(jj+1) =ii(1)
418 buffer_s(jj+2) =ii(3)
419 buffer_s(jj+3) =ii(5)
420 buffer_s(jj+4) =ii(5)
421 jj=jj+4
422 END IF
423 IF(n1/=0.AND.n2/=0.AND.n4/=0)THEN
424 buffer_s(jj+1) =ii(1)
425 buffer_s(jj+2) =ii(3)
426 buffer_s(jj+3) =ii(6)
427 buffer_s(jj+4) =ii(6)
428 jj=jj+4
429 END IF
430 IF(n2/=0.AND.n3/=0.AND.n4/=0)THEN
431 buffer_s(jj+1) =ii(3)
432 buffer_s(jj+2) =ii(5)
433 buffer_s(jj+3) =ii(6)
434 buffer_s(jj+4) =ii(6)
435 jj=jj+4
436 END IF
437 IF(n3/=0.AND.n1/=0.AND.n4/=0)THEN
438 buffer_s(jj+1) =ii(5)
439 buffer_s(jj+2) =ii(1)
440 buffer_s(jj+3) =ii(6)
441 buffer_s(jj+4) =ii(6)
442 jj=jj+4
443 END IF
444 ELSE
445
446 n1=mod(ipack/power2(1),2)
447 n2=mod(ipack/power2(2),2)
448 n3=mod(ipack/power2(3),2)
449 n4=mod(ipack/power2(4),2)
450 n5=mod(ipack/power2(5),2)
451 n6=mod(ipack/power2(6),2)
452 n7=mod(ipack/power2(7),2)
453 n8=mod(ipack/power2(8),2)
454
455 IF(n1/=0.AND.n2/=0.AND.n3/=0.AND.n4/=0)THEN
456 buffer_s(jj+1) =ii(1)
457 buffer_s(jj+2) =ii(2)
458 buffer_s(jj+3) =ii(3)
459 buffer_s(jj+4) =ii(4)
460 jj=jj+4
461 END IF
462 IF(n5/=0.AND.n6/=0.AND.n7/=0.AND.n8/=0)THEN
463 buffer_s(jj+1) =ii(5)
464 buffer_s(jj+2) =ii(6)
465 buffer_s
466
467 jj=jj+4
468 END IF
469 IF(n1/=0.AND.n5/=0.AND.n6/=0.AND.n2/=0)THEN
470 buffer_s(jj+1) =ii(1)
471 buffer_s(jj+2) =ii(5)
472 buffer_s(jj+3) =ii(6)
473 buffer_s(jj+4) =ii(2)
474 jj=jj+4
475 END IF
476 IF(n4/=0.AND.n8/=0.AND.n7/=0.AND.n3/=0)THEN
477 buffer_s(jj+1) =ii(4)
478 buffer_s(jj+2) =ii(8)
479 buffer_s(jj+3) =ii(7)
480 buffer_s(jj+4) =ii(3)
481 jj=jj+4
482 END IF
483 IF(n1/=0.AND.n4/=0.AND.n8/=0.AND.n5/=0)THEN
484 buffer_s(jj+1) =ii(1)
485 buffer_s(jj+2) =ii(4)
486 buffer_s(jj+3) =ii(8)
487 buffer_s(jj+4) =ii(5)
488 jj=jj+4
489 END IF
490 IF(n2/=0.AND.n3/=0.AND.n7/=0.AND.n6/=0)THEN
491 buffer_s(jj+1) =ii(2)
492 buffer_s(jj+2) =ii(3)
493 buffer_s(jj+3) =ii(7)
494 buffer_s(jj+4) =ii(6)
495 jj=jj
496 END IF
497 END IF
498 END IF
499 END DO
500 k0=nstrf(k0+24)
501 ENDDO
502
503
504
505
506
507 mode = 1
508 IF(nspmd>1) THEN
509 CALL spmd_gather_wa(mode,size_buffer_s,size_buffer00_r,sindex,rindex_proc,
510 1 buffer_s,buffer00_r,shift_r,nb_elem_r)
511 ELSE
512 buffer00_r(1:size_buffer00_r) = buffer_s(1:size_buffer_s)
513 ENDIF
514 DEALLOCATE( buffer_s )
515 ENDIF
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533 IF (ispmd==0.AND.nsect>0) THEN
534 DO i=1,nspmd
535 shift_sect(1,1,i) = 0
536 shift_sect(1,2,i) = rindex_proc(1,1,i)
537 shift_sect(1,3,i) = rindex_proc(1,2,i)
538 DO jj=2,nsect
539 shift_sect(jj,1,i) = rindex_proc(jj-1,3,i)
540 shift_sect(jj,2,i) = rindex_proc(jj,1,i)
541 shift_sect(jj,3,i) = rindex_proc(jj,2,i)
542 ENDDO
543 ENDDO
544
545 DO jj=1,nsect
546
547
548
549 DO i=1,nspmd
550 len = rindex_proc(jj,1,i) - shift_sect(jj,1,i)
551 IF(len>0) THEN
552 indice = 1 + shift_r(i) + shift_sect(jj,1,i)
554 ENDIF
555 ENDDO
556
557
558
559 DO i=1,nspmd
560 len = rindex_proc(jj,2,i) - rindex_proc(jj,1,i)
561 IF(len>0) THEN
562 indice = 1 + shift_r(i) + shift_sect(jj,2,i)
564 ENDIF
565 ENDDO
566
567
568
569 DO i=1,nspmd
570 len = rindex_proc(jj,3,i) - rindex_proc(jj,2,i)
571 IF(len>0) THEN
572 indice = 1 + shift_r(i) + shift_sect(jj,3,i)
574 ENDIF
575 ENDDO
576 ENDDO
577 ENDIF
578
579
580
581 IF (ispmd==0) THEN
582 n0 = numnodg + nodcut + nsect
583 n1 = numnodg + nodcut + nsect + nrwall
584
585 DO n=1,nrwall
586 ii(1) = n0
587 ii(2) = n0
588 ii(3) = n0
589 ii(4) = n0
591 n0 = n0 + 1
592 k=1
593 n2=n +nrwall
594 n3=n2+nrwall
595 n4=n3+nrwall
596 ityp= nprw(n4)
597
598 IF(iabs(ityp)==1.OR.ityp==4)THEN
599 ii(1) = n1
600 ii(2) = n1 + 3
601 ii(3) = n1 + 2
602 ii(4) = n1 + 1
604 n1 = n1 + 4
605 ELSEIF(ityp==2)THEN
606 n10 = n1
607 DO j = 1,23
608 ii(1) = n1
609 ii(2) = n1 + 2
610 ii(3) = n1 + 3
611 ii(4) = n1 + 1
613 n1 = n1 + 2
614 ENDDO
615 ii(1) = n1
616 ii(2) = n10
617 ii(3) = n10 + 1
618 ii(4) = n1 + 1
620 n1 = n1 + 2
621 ELSEIF(ityp==3)THEN
622 DO i = 1,6
623 DO j = 1,6
624 DO l = 1,6
625 ii(1) = n1
626 ii(2) = n1 + 1
627 ii(3) = n1 + 8
628 ii(4) = n1 + 7
630 n1 = n1 + 1
631 ENDDO
632 n1 = n1 + 1
633 ENDDO
634 n1 = n1 + 7
635 ENDDO
636 ENDIF
637 k=k+nprw(n)
638 IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
639 ENDDO
640 ENDIF
641
642 IF(ALLOCATED(buffer00_r)) DEALLOCATE( buffer00_r )
643
644 RETURN
end diagonal values have been computed in the(sparse) matrix id.SOL
subroutine spmd_gather_wa(mode, size_buffer_s, size_buffer_r, sindex, rindex_proc, buffer_s, buffer_r, shift_r, nb_elem_r)
void write_i_c(int *w, int *len)