OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_build_diag.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "sms_c.inc"
#include "scr03_c.inc"
#include "task_c.inc"
#include "warn_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_build_diag (itask, nodft, nodlt, ms, nodii_sms, jad_sms, jdi_sms, lt_sms, diag_sms, indx1_sms, indx2_sms, iad_elem, fr_elem, npby, lpby, lad_sms, kad_sms, jrb_sms, mskyi_sms, iskyi_sms, jadi_sms, jdii_sms, lti_sms, nodxi_sms, fr_sms, fr_rms, list_sms, list_rms, mskyi_fi_sms, ilink, rlink, nnlink, lnlink, tag_lnk_sms, ljoint, iadcj, fr_cj, itab, weight, imv, mv, mv6, w6, nprw, lprw, fr_wall, nrwl_sms, tagmsr_rby_sms, rby, awork, x, a, ar, in, v, vr, tagslv_rby_sms, irbe2, lrbe2, irbe3, lrbe3, iad_rbe3m, fr_rbe3m)

Function/Subroutine Documentation

◆ sms_build_diag()

subroutine sms_build_diag ( integer itask,
integer nodft,
integer nodlt,
ms,
integer, dimension(*) nodii_sms,
integer, dimension(*) jad_sms,
integer, dimension(*) jdi_sms,
lt_sms,
diag_sms,
integer, dimension(*) indx1_sms,
integer, dimension(*) indx2_sms,
integer, dimension(2,nspmd+1) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby,
integer, dimension(*) lad_sms,
integer, dimension(*) kad_sms,
integer, dimension(*) jrb_sms,
mskyi_sms,
integer, dimension(lskyi_sms,*) iskyi_sms,
integer, dimension(*) jadi_sms,
integer, dimension(*) jdii_sms,
lti_sms,
integer, dimension(*) nodxi_sms,
integer, dimension(nspmd+1) fr_sms,
integer, dimension(nspmd+1) fr_rms,
integer, dimension(*) list_sms,
integer, dimension(*) list_rms,
mskyi_fi_sms,
integer, dimension(*) ilink,
integer, dimension(*) rlink,
integer, dimension(10,*) nnlink,
integer, dimension(*) lnlink,
integer, dimension(*) tag_lnk_sms,
integer, dimension(*) ljoint,
integer, dimension(nspmd+1,*) iadcj,
integer, dimension(*) fr_cj,
integer, dimension(*) itab,
integer, dimension(*) weight,
integer, dimension(*) imv,
mv,
double precision, dimension(6,*) mv6,
double precision, dimension(6,*) w6,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer, dimension(nspmd+2,*) fr_wall,
integer, dimension(*) nrwl_sms,
integer, dimension(*) tagmsr_rby_sms,
rby,
awork,
x,
a,
ar,
in,
v,
vr,
integer, dimension(*) tagslv_rby_sms,
integer, dimension(*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) irbe3,
integer, dimension(*) lrbe3,
integer, dimension(*) iad_rbe3m,
integer, dimension(*) fr_rbe3m )

Definition at line 43 of file sms_build_diag.F.

57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE my_alloc_mod
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65#include "comlock.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "parit_c.inc"
73#include "sms_c.inc"
74#include "scr03_c.inc"
75#include "task_c.inc"
76#include "warn_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER ITASK, NODFT, NODLT,
81 . JAD_SMS(*), JDI_SMS(*),
82 . INDX1_SMS(*), INDX2_SMS(*),
83 . IAD_ELEM(2,NSPMD+1) ,FR_ELEM(*),
84 . NPBY(NNPBY,*), LPBY(*),
85 . LAD_SMS(*), KAD_SMS(*), JRB_SMS(*),
86 . ISKYI_SMS(LSKYI_SMS,*),
87 . JADI_SMS(*), JDII_SMS(*), NODXI_SMS(*), NODII_SMS(*),
88 . FR_SMS(NSPMD+1), FR_RMS(NSPMD+1), LIST_SMS(*), LIST_RMS(*),
89 . ILINK(*), RLINK(*), NNLINK(10,*), LNLINK(*),
90 . TAG_LNK_SMS(*), LJOINT(*), FR_CJ(*),IADCJ(NSPMD+1,*),
91 . ITAB(*), WEIGHT(*), IMV(*),
92 . NPRW(*), LPRW(*), FR_WALL(NSPMD+2,*), NRWL_SMS(*),
93 . TAGMSR_RBY_SMS(*), TAGSLV_RBY_SMS(*),
94 . IRBE2(*) ,LRBE2(*),
95 . IRBE3(*), LRBE3(*), IAD_RBE3M(*),FR_RBE3M(*)
96 my_real
97 . ms(*), lt_sms(*), diag_sms(*),
98 . mskyi_sms(*), lti_sms(*), mskyi_fi_sms(*), mv(*),
99 . rby(nrby,*), awork(3,*), x(3,*), a(3,*), ar(3,*), in(*),
100 . v(3,*), vr(3,*)
101 DOUBLE PRECISION MV6(6,*), W6(6,*)
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER I, J, K, KN, IKN, JJ, KK, II, IJ, N, M, IX, KMV
106 INTEGER NG, ITY, NEL, NFT, ISOLNOD,ILOC4(4)
107 INTEGER MSR, NSN, KI, KJ, KL, NSR, LOC_PROC, NN, MAIN
108 INTEGER K1, IC, ISMS,ICSIZE, IMOV, ITYP, ILAGM, ICOUNT,
109 . N2, N3, N4, N5, N6, N7
110 INTEGER SIZE, LENR, IAD, L, LLT, KAD, JI,
111 . NODFT1_SMS, NODLT1_SMS, NODFT2_SMS, NODLT2_SMS,
112 . NINDXT
113 INTEGER,DIMENSION(:),ALLOCATABLE :: NOD2ADD
114 INTEGER,DIMENSION(:),ALLOCATABLE :: KADI_SMS
115 INTEGER,DIMENSION(:),ALLOCATABLE :: NADI_SMS
116 my_real
117 . mele4, mele12, xn, ltij, mslv,
118 . ixx, iyy, izz, xx, yy, zz, mas,
119 . vrx, vry, vrz, v1, v2, v3, gx, gy, gz
120 DATA iloc4/2,4,6,8/
121C-----------------------------------------------
122 CALL my_alloc(nod2add,numnod)
123 CALL my_alloc(kadi_sms,numnod)
124 CALL my_alloc(nadi_sms,numnod)
125
126 nodii_sms(nodft:nodlt)=0
127 DO n=nodft,nodlt
128 IF(jadi_sms(n+1) > jadi_sms(n))THEN
129 nodii_sms(n)=1
130 END IF
131 END DO
132C
133 IF(nspmd > 1)THEN
134C
135 CALL my_barrier()
136C
137 IF(itask==0) THEN ! comm sur 1er thread
138 DO k=1,fr_rms(nspmd+1)-1
139 i=list_rms(k)
140 IF(i==0)cycle
141 nodii_sms(i)=1
142 END DO
143 loc_proc=ispmd+1
144 m = 1
145 DO k=1,nspmd
146 IF(k/=loc_proc)THEN
147 DO j=fr_sms(k),fr_sms(k+1)-1
148 i=list_sms(m)
149 m = m + 1
150 IF(i==0)cycle
151 nodii_sms(i)=1
152 END DO
153 END IF
154 END DO
155
156 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
157C
158C Echange NODII_SMS
159C
160 CALL spmd_exch_nodnx(nodii_sms,iad_elem ,fr_elem,lenr)
161C
162 END IF
163C
164 CALL my_barrier()
165C
166 END IF
167C
168 DO n=nodft,nodlt
169 IF(nodii_sms(n)/=0)THEN
170 nodxi_sms(n)=1
171 END IF
172 END DO
173C
174 IF(nrbe2/=0)THEN
175C
176 CALL my_barrier()
177C
178 IF (itask==0)THEN
179 CALL sms_rbe2_nodxi(
180 1 irbe2 ,lrbe2 ,nodxi_sms)
181 END IF
182 END IF
183C
184 IF (nrbe3/=0)THEN
185C
186 CALL my_barrier()
187C
188 IF (itask==0)THEN
189 CALL sms_rbe3_nodxi(
190 1 irbe3 ,lrbe3 ,nodxi_sms,iad_rbe3m,fr_rbe3m)
191 END IF
192 END IF
193C
194!$OMP SINGLE
195 nindx1_sms=0
196 nindx2_sms=0
197!$OMP END SINGLE
198C
199 CALL my_barrier()
200C
201 IF(itask==0)THEN
202 DO n=1,numnod
203 IF(nodxi_sms(n)/=0)THEN
204 nindx1_sms=nindx1_sms+1
205 indx1_sms(nindx1_sms)=n
206 nodxi_sms(n)=nindx1_sms
207 END IF
208 IF(nodii_sms(n)/=0)THEN
209 nindx2_sms=nindx2_sms+1
210 indx2_sms(nindx2_sms)=n
211 nodii_sms(n)=nindx2_sms
212 END IF
213 END DO
214 END IF
215C
216C-----------------------------------------------
217 IF(nlink+nrlink+njoint/=0)THEN
218C
219 CALL my_barrier()
220C
221 IF(itask==0)THEN
222 nod2add(1:numnod)=0
223C---
224 IF(nrlink/=0)THEN
225 k = 1
226 DO i=1,nrlink
227 k1=4*i-3
228 ic=ilink(k1+1)
229 IF(ic==0) cycle
230 nsn = ilink(k1)
231 isms=0
232 DO j=1,nsn
233 n=rlink(k+j-1)
234 IF(nodxi_sms(n)/=0)THEN
235 isms=1
236 EXIT
237 END IF
238 END DO
239
240 IF(nspmd > 1) CALL spmd_allglob_isum9(isms,1)
241
242 IF(isms==0)THEN
243 tag_lnk_sms(i)=-abs(tag_lnk_sms(i))
244 ELSE
245 tag_lnk_sms(i)= abs(tag_lnk_sms(i))
246 END IF
247
248 IF(isms/=0)THEN
249C
250C propagate AMS to all nodes of the rlink
251 DO j=1,nsn
252 n=rlink(k+j-1)
253 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
254 nindx1_sms=nindx1_sms+1
255 indx1_sms(nindx1_sms)=n
256 nodxi_sms(n)=nindx1_sms
257 nod2add(n)=1
258 END IF
259 END DO
260C
261 END IF
262 k = k + nsn
263 END DO
264 END IF
265C---
266 IF(nlink/=0)THEN
267 k = 1
268 DO i=1,nlink
269 ic=nnlink(3,i)
270 IF(ic==0) cycle
271 nsn = nnlink(1,i)
272 isms=0
273 DO j=1,nsn
274 n=lnlink(k+j-1)
275 IF(nodxi_sms(n)/=0)THEN
276 isms=1
277 EXIT
278 END IF
279 END DO
280
281 IF(nspmd > 1) CALL spmd_allglob_isum9(isms,1)
282
283
284 IF(isms==0)THEN
285 tag_lnk_sms(nrlink+i)=-abs(tag_lnk_sms(nrlink+i))
286 ELSE
287 tag_lnk_sms(nrlink+i)= abs(tag_lnk_sms(nrlink+i))
288 END IF
289
290 IF(isms/=0)THEN
291C
292C propagate AMS to all nodes of the rlink
293 DO j=1,nsn
294 n=lnlink(k+j-1)
295 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
296 nindx1_sms=nindx1_sms+1
297 indx1_sms(nindx1_sms)=n
298 nodxi_sms(n)=nindx1_sms
299 nod2add(n)=1
300 END IF
301 END DO
302C
303 END IF
304 k = k + nsn
305 END DO
306 END IF
307C-----------------------------------------------
308 IF(njoint/=0)THEN
309 IF(ispmd==0)THEN
310 k=1
311 DO j=1,njoint
312 nsn=ljoint(k)
313 isms=0
314 DO i=1,nsn
315 n=ljoint(k+i)
316 IF(nodxi_sms(n)/=0)THEN
317 isms=1
318 EXIT
319 END IF
320 END DO
321
322 tag_lnk_sms(nrlink+nlink+j)=isms
323
324 k=k+nsn+1
325 END DO
326 END IF
327C
328 IF(nspmd > 1)
329 . CALL spmd_ibcast(tag_lnk_sms(nrlink+nlink+1),
330 . tag_lnk_sms(nrlink+nlink+1),njoint,1,0,2)
331C
332
333 IF(nspmd==1)THEN
334 k=1
335 DO j=1,njoint
336 isms=tag_lnk_sms(nrlink+nlink+j)
337 IF(isms/=0)THEN
338 nsn=ljoint(k)
339 DO i=1,nsn
340 n=ljoint(k+i)
341 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
342 nindx1_sms=nindx1_sms+1
343 indx1_sms(nindx1_sms)=n
344 nodxi_sms(n)=nindx1_sms
345 nod2add(n)=1
346 END IF
347 END DO
348 END IF
349 k=k+nsn+1
350 END DO
351 ELSE
352 IF(ispmd==0)THEN
353 k=1
354 DO j=1,njoint
355 isms=tag_lnk_sms(nrlink+nlink+j)
356 IF(isms/=0)THEN
357 nsn=ljoint(k)
358 DO i=1,nsn
359 n=ljoint(k+i)
360 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
361 nindx1_sms=nindx1_sms+1
362 indx1_sms(nindx1_sms)=n
363 nodxi_sms(n)=nindx1_sms
364 nod2add(n)=1
365 END IF
366 END DO
367 END IF
368 k=k+nsn+1
369 END DO
370 END IF
371 icsize=0
372 DO n=1,njoint
373 IF(tag_lnk_sms(nrlink+nlink+n)/=0)
374 . icsize=icsize+iadcj(nspmd+1,n)-iadcj(1,n)
375 END DO
376 CALL spmd_sd_cj_2(nod2add,ljoint,fr_cj,iadcj,icsize,
377 . tag_lnk_sms(nrlink+nlink+1),nodxi_sms,
378 . indx1_sms)
379 END IF
380 END IF
381 END IF
382 END IF
383C-----------------------------------------------
384 IF(nrwall > 0)THEN
385 IF(itask==0)THEN
386 k = 1
387 DO n=1,nrwall
388 n2=n +nrwall
389 n3=n2+nrwall
390 n4=n3+nrwall
391 n5=n4+nrwall
392 n6=n5+nrwall
393 n7=n6+nrwall
394 nsn =nprw(n)
395 imov =nprw(n3)
396 ityp =nprw(n4)
397 ilagm=nprw(n6)
398 icount =k
399 IF(ilagm==0)THEN
400 DO j=1,nsn
401 i=lprw(k+j-1)
402 IF(nodxi_sms(i)/=0)THEN
403 nrwl_sms(icount)=j
404 icount=icount+1
405 END IF
406 END DO
407 END IF
408C nb of ams nodes in the wall
409 nprw(n7)=icount-k
410C for sms_fixvel, etc
411 IF(imov /= 0)THEN
412 nod2add(imov)=0
413 IF(icount > k.AND.nodxi_sms(imov)==0)nod2add(imov)=1
414 IF(nspmd > 1)
415 . CALL spmd_frwall_nn(fr_wall(1,n),nod2add(imov))
416 IF(nod2add(imov)/=0)THEN
417 nindx1_sms=nindx1_sms+1
418 indx1_sms(nindx1_sms)=imov
419 nodxi_sms(imov)=nindx1_sms
420 END IF
421 END IF
422 k =k+nsn
423 END DO
424 END IF
425 END IF
426C-----------------------------------------------
427C
428 kmv=0
429C
430 IF(idtmins/=0)THEN
431 IF(iparit==0.OR.debug(9)==0)THEN
432 DO i=nodft,nodlt
433C reset du passe
434 diag_sms(i)= zero
435 DO ij=jad_sms(i),jad_sms(i+1)-1
436 diag_sms(i)=diag_sms(i)-lt_sms(ij)
437 END DO
438 END DO
439 ELSE
440 DO i=nodft,nodlt
441C reset du passe
442 diag_sms(i)= zero
443 END DO
444C
445 CALL my_barrier
446C
447 nodft1_sms=1+itask*nindx1_sms/nthread
448 nodlt1_sms=(itask+1)*nindx1_sms/nthread
449C
450 DO n=nodft1_sms,nodlt1_sms
451 i=indx1_sms(n)
452 DO ij=jad_sms(i),jad_sms(i+1)-1
453 kmv=kmv+1
454 imv(kmv)=i
455 mv(kmv)=-lt_sms(ij)
456 END DO
457 END DO
458 END IF
459 ELSE
460C
461C /DT/INTER/AMS
462 DO i=nodft,nodlt
463C reset du passe
464 diag_sms(i)= zero
465 END DO
466 END IF
467C-----------------------------------------------
468 CALL my_barrier ! barriere avt NODFT2_SMS,NODLT2_SMS
469C-----------------------------------------------
470 nodft2_sms=1+itask*nindx2_sms/nthread
471 nodlt2_sms=(itask+1)*nindx2_sms/nthread
472C
473 IF(iparit==0)THEN
474C
475 DO n=nodft2_sms,nodlt2_sms
476 i=indx2_sms(n)
477 DO ij=jadi_sms(i),jadi_sms(i+1)-1
478 diag_sms(i)=diag_sms(i)-lti_sms(ij)
479 END DO
480 END DO
481C
482 IF(nspmd > 1)THEN
483C
484 CALL my_barrier()
485C
486 IF(itask==0) THEN ! comm sur 1er thread
487
488 loc_proc = ispmd+1
489 m = 1
490 DO k=1,fr_sms(loc_proc)-1
491 i=list_sms(m)
492 m = m + 1
493 IF(i==0)cycle
494 diag_sms(i)=diag_sms(i)+mskyi_sms(k)
495 END DO
496
497 DO k=fr_sms(loc_proc+1),fr_sms(nspmd+1)-1
498 i=list_sms(m)
499 m = m + 1
500 IF(i==0)cycle
501 diag_sms(i)=diag_sms(i)+mskyi_sms(k)
502 END DO
503
504 CALL spmd_mij_sms(
505 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
506 2 mskyi_fi_sms)
507
508 DO k=1,fr_rms(nspmd+1)-1
509 i=list_rms(k)
510 IF(i==0)cycle
511 diag_sms(i)=diag_sms(i)+mskyi_fi_sms(k)
512 END DO
513
514 END IF
515C
516 CALL my_barrier
517C
518 IF(itask==0) THEN ! comm sur 1er thread
519 SIZE = 1
520 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
521C
522C Echange DIAG_SMS
523C
524 CALL spmd_exch_sms(
525 . diag_sms,nodxi_sms,iad_elem ,fr_elem,SIZE,
526 . lenr)
527 END IF
528 END IF
529C
530 ELSEIF(debug(9)==0)THEN
531C---------------------------------------------------------------------
532C Parith/ON is ensured when changing n of threads, not n of domains
533C---------------------------------------------------------------------
534 DO n=nodft2_sms,nodlt2_sms
535 i=indx2_sms(n)
536 DO ij=jadi_sms(i),jadi_sms(i+1)-1
537 kmv=kmv+1
538 imv(kmv)=i
539 mv(kmv)=-lti_sms(ij)
540 END DO
541 END DO
542C
543 IF(nspmd > 1)THEN
544 loc_proc = ispmd+1
545 m = 1
546 DO k=1,fr_sms(loc_proc)-1
547 i=list_sms(m)
548 m = m + 1
549 IF(i == 0 .OR. nodii_sms(i) < nodft2_sms .OR.
550 . nodlt2_sms < nodii_sms(i))cycle
551 kmv=kmv+1
552 imv(kmv)=i
553 mv(kmv)=mskyi_sms(k)
554 END DO
555
556 DO k=fr_sms(loc_proc+1),fr_sms(nspmd+1)-1
557 i=list_sms(m)
558 m = m + 1
559 IF(i == 0 .OR. nodii_sms(i) < nodft2_sms .OR.
560 . nodlt2_sms < nodii_sms(i))cycle
561 kmv=kmv+1
562 imv(kmv)=i
563 mv(kmv)=mskyi_sms(k)
564 END DO
565
566 IF(itask==0) THEN ! comm sur 1er thread
567 CALL spmd_mij_sms(
568 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
569 2 mskyi_fi_sms)
570 END IF
571C
572 CALL my_barrier()
573C
574 DO k=1,fr_rms(nspmd+1)-1
575 i=list_rms(k)
576 IF(i == 0 .OR. nodii_sms(i) < nodft2_sms .OR.
577 . nodlt2_sms < nodii_sms(i))cycle
578 kmv=kmv+1
579 imv(kmv)=i
580 mv(kmv)=mskyi_fi_sms(k)
581 END DO
582C
583 END IF
584C
585 DO n=nodft2_sms,nodlt2_sms
586 i=indx2_sms(n)
587 DO j=1,6
588 w6(j,i)=zero
589 END DO
590 END DO
591C
592 CALL foat_to_6_float(1,kmv,mv,mv6)
593C
594 DO k=1,kmv
595 i=imv(k)
596 DO j=1,6
597 w6(j,i) = w6(j,i)+mv6(j,k)
598 END DO
599 END DO
600C
601 CALL my_barrier()
602C
603 DO n=nodft2_sms,nodlt2_sms
604 i=indx2_sms(n)
605 diag_sms(i) = diag_sms(i)
606 . +w6(1,i)+w6(2,i)+w6(3,i)
607 . +w6(4,i)+w6(5,i)+w6(6,i)
608 END DO
609C
610 IF(nspmd > 1) THEN
611C
612 CALL my_barrier()
613C
614 IF(itask==0) THEN ! comm sur 1er thread
615 SIZE = 1
616 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
617C
618C Echange DIAG_SMS
619C
620 CALL spmd_exch_sms(
621 . diag_sms,nodxi_sms,iad_elem ,fr_elem,SIZE,
622 . lenr)
623 END IF
624C
625 END IF
626C
627 ELSE ! IF(IPARIT==1.AND.DEBUG(9)==1)
628C---------------------------------------------------------------------
629C Parith/ON is ensured when changing n of threads and/or n of domains
630C---------------------------------------------------------------------
631C
632 CALL my_barrier()
633C
634 nodft1_sms=1+itask*nindx1_sms/nthread
635 nodlt1_sms=(itask+1)*nindx1_sms/nthread
636C
637 DO n=nodft1_sms,nodlt1_sms
638 i=indx1_sms(n)
639 DO ij=jadi_sms(i),jadi_sms(i+1)-1
640 kmv=kmv+1
641 imv(kmv)=i
642 mv(kmv)=-lti_sms(ij)
643 END DO
644 END DO
645C
646 IF(nspmd > 1)THEN
647 loc_proc = ispmd+1
648 m = 1
649 DO k=1,fr_sms(loc_proc)-1
650 i=list_sms(m)
651 m = m + 1
652 IF(i == 0 .OR. nodxi_sms(i) < nodft1_sms .OR.
653 . nodlt1_sms < nodxi_sms(i))cycle
654 kmv=kmv+1
655 imv(kmv)=i
656 mv(kmv)=mskyi_sms(k)
657 END DO
658
659 DO k=fr_sms(loc_proc+1),fr_sms(nspmd+1)-1
660 i=list_sms(m)
661 m = m + 1
662 IF(i == 0 .OR. nodxi_sms(i) < nodft1_sms .OR.
663 . nodlt1_sms < nodxi_sms(i))cycle
664 kmv=kmv+1
665 imv(kmv)=i
666 mv(kmv)=mskyi_sms(k)
667 END DO
668
669 IF(itask==0) THEN ! comm sur 1er thread
670 CALL spmd_mij_sms(
671 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
672 2 mskyi_fi_sms)
673 END IF
674C
675 CALL my_barrier()
676C
677 DO k=1,fr_rms(nspmd+1)-1
678 i=list_rms(k)
679 IF(i == 0 .OR. nodxi_sms(i) < nodft1_sms .OR.
680 . nodlt1_sms < nodxi_sms(i))cycle
681 kmv=kmv+1
682 imv(kmv)=i
683 mv(kmv)=mskyi_fi_sms(k)
684 END DO
685C
686 END IF
687C
688 DO n=nodft1_sms,nodlt1_sms
689 i=indx1_sms(n)
690 DO j=1,6
691 w6(j,i)=zero
692 END DO
693 END DO
694C
695 CALL foat_to_6_float(1,kmv,mv,mv6)
696C
697 DO k=1,kmv
698 i=imv(k)
699 DO j=1,6
700 w6(j,i) = w6(j,i)+mv6(j,k)
701 END DO
702 END DO
703C
704 IF(nspmd > 1) THEN
705C
706 CALL my_barrier()
707C
708 IF(itask==0) THEN ! comm sur 1er thread
709 SIZE = 1
710 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
711C
712C Echange DIAG_SMS
713C
714 CALL spmd_exch_sms6(
715 . w6,nodxi_sms,iad_elem ,fr_elem,SIZE,
716 . lenr)
717 END IF
718C
719 END IF
720C
721 CALL my_barrier()
722C
723 DO n=nodft1_sms,nodlt1_sms
724 i=indx1_sms(n)
725 diag_sms(i) = w6(1,i)+w6(2,i)+w6(3,i)
726 . +w6(4,i)+w6(5,i)+w6(6,i)
727 END DO
728C
729 END IF
730C-----------------------------------------------
731C
732 CALL my_barrier
733C
734 DO n=nodft,nodlt
735 IF(tagslv_rby_sms(n)==0) diag_sms(n) = ms(n)+diag_sms(n)
736 END DO
737C
738 CALL my_barrier
739C
740 DEALLOCATE(nod2add)
741 DEALLOCATE(kadi_sms)
742 DEALLOCATE(nadi_sms)
743
744 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:225
sms_rbe2_nodxi
subroutine sms_rbe2_nodxi(irbe2, lrbe2, nodxi_sms)
Definition sms_rbe2.F:209
sms_rbe3_nodxi
subroutine sms_rbe3_nodxi(irbe3, lrbe3, nodxi_sms, iad_m, fr_m)
Definition sms_rbe3.F:35
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
spmd_exch_nodnx
subroutine spmd_exch_nodnx(nodnx_sms, iad_elem, fr_elem, lenr)
Definition spmd_exch_nodnx.F:33
spmd_exch_sms6
subroutine spmd_exch_sms6(v, nodnx_sms, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_sms6.F:34
spmd_exch_sms
subroutine spmd_exch_sms(v, nodnx_sms, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_sms.F:36
spmd_frwall_nn
subroutine spmd_frwall_nn(fr_wall, iwadd)
Definition spmd_frwall_nn.F:34
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_sd_cj_2
subroutine spmd_sd_cj_2(nod2add, ljoint, fr_cj, iadcj, icsize, tag_lnk_sms, nodnx_sms, indx1_sms)
Definition spmd_sd_cj_2.F:35
spmd_mij_sms
subroutine spmd_mij_sms(iskyi_sms, fr_sms, fr_rms, list_rms, mskyi_sms, mij_sms)
Definition spmd_sms.F:452
my_barrier
subroutine my_barrier
Definition machine.F:31