OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_build_diag.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!|| sms_build_diag ../engine/source/ams/sms_build_diag.F
25!||--- called by ------------------------------------------------------
26!|| sms_build_mat_2 ../engine/source/ams/sms_build_mat_2.F
27!||--- calls -----------------------------------------------------
28!|| foat_to_6_float ../engine/source/system/parit.F
29!|| my_barrier ../engine/source/system/machine.F
30!|| sms_rbe2_nodxi ../engine/source/ams/sms_rbe2.F
31!|| sms_rbe3_nodxi ../engine/source/ams/sms_rbe3.F
32!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
33!|| spmd_exch_nodnx ../engine/source/mpi/ams/spmd_exch_nodnx.F
34!|| spmd_exch_sms ../engine/source/mpi/ams/spmd_exch_sms.F
35!|| spmd_exch_sms6 ../engine/source/mpi/ams/spmd_exch_sms6.F
36!|| spmd_frwall_nn ../engine/source/mpi/kinematic_conditions/spmd_frwall_nn.f
37!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
38!|| spmd_mij_sms ../engine/source/mpi/ams/spmd_sms.F
39!|| spmd_sd_cj_2 ../engine/source/mpi/kinematic_conditions/spmd_sd_cj_2.F
40!||--- uses -----------------------------------------------------
41!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
42!||====================================================================
43 SUBROUTINE sms_build_diag(
44 1 ITASK ,NODFT ,NODLT ,MS ,NODII_SMS ,
45 2 JAD_SMS ,JDI_SMS ,LT_SMS ,DIAG_SMS,INDX1_SMS ,
46 3 INDX2_SMS,IAD_ELEM,FR_ELEM ,NPBY ,LPBY,
47 4 LAD_SMS ,KAD_SMS ,JRB_SMS ,MSKYI_SMS,ISKYI_SMS ,
48 5 JADI_SMS,JDII_SMS ,LTI_SMS ,NODXI_SMS,FR_SMS ,
49 6 FR_RMS ,LIST_SMS ,LIST_RMS ,MSKYI_FI_SMS,ILINK ,
50 7 RLINK ,NNLINK ,LNLINK ,TAG_LNK_SMS ,LJOINT,
51 8 IADCJ ,FR_CJ ,ITAB ,WEIGHT ,IMV ,
52 9 MV ,MV6 ,W6 ,NPRW ,LPRW ,
53 A FR_WALL ,NRWL_SMS ,TAGMSR_RBY_SMS,RBY ,AWORK ,
54 B X ,A ,AR ,IN ,V ,
55 C VR ,TAGSLV_RBY_SMS,IRBE2,LRBE2 ,IRBE3 ,
56 D LRBE3 ,IAD_RBE3M,FR_RBE3M )
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, IJ, N, M, KMV
106 INTEGER ILOC4(4)
107 INTEGER NSN, LOC_PROC
108 INTEGER K1, IC, ISMS,ICSIZE, IMOV, ITYP, ILAGM, ICOUNT,
109 . n2, n3, n4, n5, n6, n7
110 INTEGER SIZE, LENR,
111 . NODFT1_SMS, NODLT1_SMS, NODFT2_SMS, NODLT2_SMS
112 INTEGER,DIMENSION(:),ALLOCATABLE :: NOD2ADD
113 INTEGER,DIMENSION(:),ALLOCATABLE :: KADI_SMS
114 INTEGER,DIMENSION(:),ALLOCATABLE :: NADI_SMS
115 DATA ILOC4/2,4,6,8/
116C-----------------------------------------------
117 CALL MY_ALLOC(NOD2ADD,NUMNOD)
118 CALL my_alloc(kadi_sms,numnod)
119 CALL my_alloc(nadi_sms,numnod)
120
121 nodii_sms(nodft:nodlt)=0
122 DO n=nodft,nodlt
123 IF(jadi_sms(n+1) > jadi_sms(n))THEN
124 nodii_sms(n)=1
125 END IF
126 END DO
127C
128 IF(nspmd > 1)THEN
129C
130 CALL my_barrier()
131C
132 IF(itask==0) THEN ! comm on 1st thread
133 DO k=1,fr_rms(nspmd+1)-1
134 i=list_rms(k)
135 IF(i==0)cycle
136 nodii_sms(i)=1
137 END DO
138 loc_proc=ispmd+1
139 m = 1
140 DO k=1,nspmd
141 IF(k/=loc_proc)THEN
142 DO j=fr_sms(k),fr_sms(k+1)-1
143 i=list_sms(m)
144 m = m + 1
145 IF(i==0)cycle
146 nodii_sms(i)=1
147 END DO
148 END IF
149 END DO
150
151 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
152C
153C Echange NODII_SMS
154C
155 CALL spmd_exch_nodnx(nodii_sms,iad_elem ,fr_elem,lenr)
156C
157 END IF
158C
159 CALL my_barrier()
160C
161 END IF
162C
163 DO n=nodft,nodlt
164 IF(nodii_sms(n)/=0)THEN
165 nodxi_sms(n)=1
166 END IF
167 END DO
168C
169 IF(nrbe2/=0)THEN
170C
171 CALL my_barrier()
172C
173 IF (itask==0)THEN
174 CALL sms_rbe2_nodxi(
175 1 irbe2 ,lrbe2 ,nodxi_sms)
176 END IF
177 END IF
178C
179 IF (nrbe3/=0)THEN
180C
181 CALL my_barrier()
182C
183 IF (itask==0)THEN
184 CALL sms_rbe3_nodxi(
185 1 irbe3 ,lrbe3 ,nodxi_sms,iad_rbe3m,fr_rbe3m)
186 END IF
187 END IF
188C
189!$OMP SINGLE
190 nindx1_sms=0
191 nindx2_sms=0
192!$OMP END SINGLE
193C
194 CALL my_barrier()
195C
196 IF(itask==0)THEN
197 DO n=1,numnod
198 IF(nodxi_sms(n)/=0)THEN
199 nindx1_sms=nindx1_sms+1
200 indx1_sms(nindx1_sms)=n
201 nodxi_sms(n)=nindx1_sms
202 END IF
203 IF(nodii_sms(n)/=0)THEN
204 nindx2_sms=nindx2_sms+1
205 indx2_sms(nindx2_sms)=n
206 nodii_sms(n)=nindx2_sms
207 END IF
208 END DO
209 END IF
210C
211C-----------------------------------------------
212 IF(nlink+nrlink+njoint/=0)THEN
213C
214 CALL my_barrier()
215C
216 IF(itask==0)THEN
217 nod2add(1:numnod)=0
218C---
219 IF(nrlink/=0)THEN
220 k = 1
221 DO i=1,nrlink
222 k1=4*i-3
223 ic=ilink(k1+1)
224 IF(ic==0) cycle
225 nsn = ilink(k1)
226 isms=0
227 DO j=1,nsn
228 n=rlink(k+j-1)
229 IF(nodxi_sms(n)/=0)THEN
230 isms=1
231 EXIT
232 END IF
233 END DO
234
235 IF(nspmd > 1) CALL spmd_allglob_isum9(isms,1)
236
237 IF(isms==0)THEN
238 tag_lnk_sms(i)=-abs(tag_lnk_sms(i))
239 ELSE
240 tag_lnk_sms(i)= abs(tag_lnk_sms(i))
241 END IF
242
243 IF(isms/=0)THEN
244C
245C propagate AMS to all nodes of the rlink
246 DO j=1,nsn
247 n=rlink(k+j-1)
248 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
249 nindx1_sms=nindx1_sms+1
250 indx1_sms(nindx1_sms)=n
251 nodxi_sms(n)=nindx1_sms
252 nod2add(n)=1
253 END IF
254 END DO
255C
256 END IF
257 k = k + nsn
258 END DO
259 END IF
260C---
261 IF(nlink/=0)THEN
262 k = 1
263 DO i=1,nlink
264 ic=nnlink(3,i)
265 IF(ic==0) cycle
266 nsn = nnlink(1,i)
267 isms=0
268 DO j=1,nsn
269 n=lnlink(k+j-1)
270 IF(nodxi_sms(n)/=0)THEN
271 isms=1
272 EXIT
273 END IF
274 END DO
275
276 IF(nspmd > 1) CALL spmd_allglob_isum9(isms,1)
277
278
279 IF(isms==0)THEN
280 tag_lnk_sms(nrlink+i)=-abs(tag_lnk_sms(nrlink+i))
281 ELSE
282 tag_lnk_sms(nrlink+i)= abs(tag_lnk_sms(nrlink+i))
283 END IF
284
285 IF(isms/=0)THEN
286C
287C propagate AMS to all nodes of the rlink
288 DO j=1,nsn
289 n=lnlink(k+j-1)
290 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
291 nindx1_sms=nindx1_sms+1
292 indx1_sms(nindx1_sms)=n
293 nodxi_sms(n)=nindx1_sms
294 nod2add(n)=1
295 END IF
296 END DO
297C
298 END IF
299 k = k + nsn
300 END DO
301 END IF
302C-----------------------------------------------
303 IF(njoint/=0)THEN
304 IF(ispmd==0)THEN
305 k=1
306 DO j=1,njoint
307 nsn=ljoint(k)
308 isms=0
309 DO i=1,nsn
310 n=ljoint(k+i)
311 IF(nodxi_sms(n)/=0)THEN
312 isms=1
313 EXIT
314 END IF
315 END DO
316
317 tag_lnk_sms(nrlink+nlink+j)=isms
318
319 k=k+nsn+1
320 END DO
321 END IF
322C
323 IF(nspmd > 1)
324 . CALL spmd_ibcast(tag_lnk_sms(nrlink+nlink+1),
325 . tag_lnk_sms(nrlink+nlink+1),njoint,1,0,2)
326C
327
328 IF(nspmd==1)THEN
329 k=1
330 DO j=1,njoint
331 isms=tag_lnk_sms(nrlink+nlink+j)
332 IF(isms/=0)THEN
333 nsn=ljoint(k)
334 DO i=1,nsn
335 n=ljoint(k+i)
336 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
337 nindx1_sms=nindx1_sms+1
338 indx1_sms(nindx1_sms)=n
339 nodxi_sms(n)=nindx1_sms
340 nod2add(n)=1
341 END IF
342 END DO
343 END IF
344 k=k+nsn+1
345 END DO
346 ELSE
347 IF(ispmd==0)THEN
348 k=1
349 DO j=1,njoint
350 isms=tag_lnk_sms(nrlink+nlink+j)
351 IF(isms/=0)THEN
352 nsn=ljoint(k)
353 DO i=1,nsn
354 n=ljoint(k+i)
355 IF(nodxi_sms(n)==0.AND.nod2add(n)==0)THEN
356 nindx1_sms=nindx1_sms+1
357 indx1_sms(nindx1_sms)=n
358 nodxi_sms(n)=nindx1_sms
359 nod2add(n)=1
360 END IF
361 END DO
362 END IF
363 k=k+nsn+1
364 END DO
365 END IF
366 icsize=0
367 DO n=1,njoint
368 IF(tag_lnk_sms(nrlink+nlink+n)/=0)
369 . icsize=icsize+iadcj(nspmd+1,n)-iadcj(1,n)
370 END DO
371 CALL spmd_sd_cj_2(nod2add,ljoint,fr_cj,iadcj,icsize,
372 . tag_lnk_sms(nrlink+nlink+1),nodxi_sms,
373 . indx1_sms)
374 END IF
375 END IF
376 END IF
377 END IF
378C-----------------------------------------------
379 IF(nrwall > 0)THEN
380 IF(itask==0)THEN
381 k = 1
382 DO n=1,nrwall
383 n2=n +nrwall
384 n3=n2+nrwall
385 n4=n3+nrwall
386 n5=n4+nrwall
387 n6=n5+nrwall
388 n7=n6+nrwall
389 nsn =nprw(n)
390 imov =nprw(n3)
391 ityp =nprw(n4)
392 ilagm=nprw(n6)
393 icount =k
394 IF(ilagm==0)THEN
395 DO j=1,nsn
396 i=lprw(k+j-1)
397 IF(nodxi_sms(i)/=0)THEN
398 nrwl_sms(icount)=j
399 icount=icount+1
400 END IF
401 END DO
402 END IF
403C nb of ams nodes in the wall
404 nprw(n7)=icount-k
405C for sms_fixvel, etc
406 IF(imov /= 0)THEN
407 nod2add(imov)=0
408 IF(icount > k.AND.nodxi_sms(imov)==0)nod2add(imov)=1
409 IF(nspmd > 1)
410 . CALL spmd_frwall_nn(fr_wall(1,n),nod2add(imov))
411 IF(nod2add(imov)/=0)THEN
412 nindx1_sms=nindx1_sms+1
413 indx1_sms(nindx1_sms)=imov
414 nodxi_sms(imov)=nindx1_sms
415 END IF
416 END IF
417 k =k+nsn
418 END DO
419 END IF
420 END IF
421C-----------------------------------------------
422C
423 kmv=0
424C
425 IF(idtmins/=0)THEN
426 IF(iparit==0.OR.debug(9)==0)THEN
427 DO i=nodft,nodlt
428C reset of the past
429 diag_sms(i)= zero
430 DO ij=jad_sms(i),jad_sms(i+1)-1
431 diag_sms(i)=diag_sms(i)-lt_sms(ij)
432 END DO
433 END DO
434 ELSE
435 DO i=nodft,nodlt
436C reset of the past
437 diag_sms(i)= zero
438 END DO
439C
440 CALL my_barrier
441C
442 nodft1_sms=1+itask*nindx1_sms/nthread
443 nodlt1_sms=(itask+1)*nindx1_sms/nthread
444C
445 DO n=nodft1_sms,nodlt1_sms
446 i=indx1_sms(n)
447 DO ij=jad_sms(i),jad_sms(i+1)-1
448 kmv=kmv+1
449 imv(kmv)=i
450 mv(kmv)=-lt_sms(ij)
451 END DO
452 END DO
453 END IF
454 ELSE
455C
456C /DT/INTER/AMS
457 DO i=nodft,nodlt
458C reset of the past
459 diag_sms(i)= zero
460 END DO
461 END IF
462C-----------------------------------------------
463 CALL my_barrier ! barriere avt NODFT2_SMS,NODLT2_SMS
464C-----------------------------------------------
465 nodft2_sms=1+itask*nindx2_sms/nthread
466 nodlt2_sms=(itask+1)*nindx2_sms/nthread
467C
468 IF(iparit==0)THEN
469C
470 DO n=nodft2_sms,nodlt2_sms
471 i=indx2_sms(n)
472 DO ij=jadi_sms(i),jadi_sms(i+1)-1
473 diag_sms(i)=diag_sms(i)-lti_sms(ij)
474 END DO
475 END DO
476C
477 IF(nspmd > 1)THEN
478C
479 CALL my_barrier()
480C
481 IF(itask==0) THEN ! communication on the first thread
482
483 loc_proc = ispmd+1
484 m = 1
485 DO k=1,fr_sms(loc_proc)-1
486 i=list_sms(m)
487 m = m + 1
488 IF(i==0)cycle
489 diag_sms(i)=diag_sms(i)+mskyi_sms(k)
490 END DO
491
492 DO k=fr_sms(loc_proc+1),fr_sms(nspmd+1)-1
493 i=list_sms(m)
494 m = m + 1
495 IF(i==0)cycle
496 diag_sms(i)=diag_sms(i)+mskyi_sms(k)
497 END DO
498
499 CALL spmd_mij_sms(
500 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
501 2 mskyi_fi_sms)
502
503 DO k=1,fr_rms(nspmd+1)-1
504 i=list_rms(k)
505 IF(i==0)cycle
506 diag_sms(i)=diag_sms(i)+mskyi_fi_sms(k)
507 END DO
508
509 END IF
510C
511 CALL my_barrier
512C
513 IF(itask==0) THEN ! communication on the first thread
514 SIZE = 1
515 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
516C
517C Echange DIAG_SMS
518C
519 CALL spmd_exch_sms(
520 . diag_sms,nodxi_sms,iad_elem ,fr_elem,SIZE,
521 . lenr)
522 END IF
523 END IF
524C
525 ELSEIF(debug(9)==0)THEN
526C---------------------------------------------------------------------
527C Parith/ON is ensured when changing n of threads, not n of domains
528C---------------------------------------------------------------------
529 DO n=nodft2_sms,nodlt2_sms
530 i=indx2_sms(n)
531 DO ij=jadi_sms(i),jadi_sms(i+1)-1
532 kmv=kmv+1
533 imv(kmv)=i
534 mv(kmv)=-lti_sms(ij)
535 END DO
536 END DO
537C
538 IF(nspmd > 1)THEN
539 loc_proc = ispmd+1
540 m = 1
541 DO k=1,fr_sms(loc_proc)-1
542 i=list_sms(m)
543 m = m + 1
544 IF(i == 0 .OR. nodii_sms(i) < nodft2_sms .OR.
545 . nodlt2_sms < nodii_sms(i))cycle
546 kmv=kmv+1
547 imv(kmv)=i
548 mv(kmv)=mskyi_sms(k)
549 END DO
550
551 DO k=fr_sms(loc_proc+1),fr_sms(nspmd+1)-1
552 i=list_sms(m)
553 m = m + 1
554 IF(i == 0 .OR. nodii_sms(i) < nodft2_sms .OR.
555 . nodlt2_sms < nodii_sms(i))cycle
556 kmv=kmv+1
557 imv(kmv)=i
558 mv(kmv)=mskyi_sms(k)
559 END DO
560
561 IF(itask==0) THEN ! communication on the first thread
562 CALL spmd_mij_sms(
563 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
564 2 mskyi_fi_sms)
565 END IF
566C
567 CALL my_barrier()
568C
569 DO k=1,fr_rms(nspmd+1)-1
570 i=list_rms(k)
571 IF(i == 0 .OR. nodii_sms(i) < nodft2_sms .OR.
572 . nodlt2_sms < nodii_sms(i))cycle
573 kmv=kmv+1
574 imv(kmv)=i
575 mv(kmv)=mskyi_fi_sms(k)
576 END DO
577C
578 END IF
579C
580 DO n=nodft2_sms,nodlt2_sms
581 i=indx2_sms(n)
582 DO j=1,6
583 w6(j,i)=zero
584 END DO
585 END DO
586C
587 CALL foat_to_6_float(1,kmv,mv,mv6)
588C
589 DO k=1,kmv
590 i=imv(k)
591 DO j=1,6
592 w6(j,i) = w6(j,i)+mv6(j,k)
593 END DO
594 END DO
595C
596 CALL my_barrier()
597C
598 DO n=nodft2_sms,nodlt2_sms
599 i=indx2_sms(n)
600 diag_sms(i) = diag_sms(i)
601 . +w6(1,i)+w6(2,i)+w6(3,i)
602 . +w6(4,i)+w6(5,i)+w6(6,i)
603 END DO
604C
605 IF(nspmd > 1) THEN
606C
607 CALL my_barrier()
608C
609 IF(itask==0) THEN ! communication on the first thread
610 SIZE = 1
611 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
612C
613C Echange DIAG_SMS
614C
615 CALL spmd_exch_sms(
616 . diag_sms,nodxi_sms,iad_elem ,fr_elem,SIZE,
617 . lenr)
618 END IF
619C
620 END IF
621C
622 ELSE ! IF(IPARIT==1.AND.DEBUG(9)==1)
623C---------------------------------------------------------------------
624C Parith/ON is ensured when changing n of threads and/or n of domains
625C---------------------------------------------------------------------
626C
627 CALL my_barrier()
628C
629 nodft1_sms=1+itask*nindx1_sms/nthread
630 nodlt1_sms=(itask+1)*nindx1_sms/nthread
631C
632 DO n=nodft1_sms,nodlt1_sms
633 i=indx1_sms(n)
634 DO ij=jadi_sms(i),jadi_sms(i+1)-1
635 kmv=kmv+1
636 imv(kmv)=i
637 mv(kmv)=-lti_sms(ij)
638 END DO
639 END DO
640C
641 IF(nspmd > 1)THEN
642 loc_proc = ispmd+1
643 m = 1
644 DO k=1,fr_sms(loc_proc)-1
645 i=list_sms(m)
646 m = m + 1
647 IF(i == 0 .OR. nodxi_sms(i) < nodft1_sms .OR.
648 . nodlt1_sms < nodxi_sms(i))cycle
649 kmv=kmv+1
650 imv(kmv)=i
651 mv(kmv)=mskyi_sms(k)
652 END DO
653
654 DO k=fr_sms(loc_proc+1),fr_sms(nspmd+1)-1
655 i=list_sms(m)
656 m = m + 1
657 IF(i == 0 .OR. nodxi_sms(i) < nodft1_sms .OR.
658 . nodlt1_sms < nodxi_sms(i))cycle
659 kmv=kmv+1
660 imv(kmv)=i
661 mv(kmv)=mskyi_sms(k)
662 END DO
663
664 IF(itask==0) THEN ! communication on the first thread
665 CALL spmd_mij_sms(
666 1 iskyi_sms,fr_sms,fr_rms,list_rms,mskyi_sms,
667 2 mskyi_fi_sms)
668 END IF
669C
670 CALL my_barrier()
671C
672 DO k=1,fr_rms(nspmd+1)-1
673 i=list_rms(k)
674 IF(i == 0 .OR. nodxi_sms(i) < nodft1_sms .OR.
675 . nodlt1_sms < nodxi_sms(i))cycle
676 kmv=kmv+1
677 imv(kmv)=i
678 mv(kmv)=mskyi_fi_sms(k)
679 END DO
680C
681 END IF
682C
683 DO n=nodft1_sms,nodlt1_sms
684 i=indx1_sms(n)
685 DO j=1,6
686 w6(j,i)=zero
687 END DO
688 END DO
689C
690 CALL foat_to_6_float(1,kmv,mv,mv6)
691C
692 DO k=1,kmv
693 i=imv(k)
694 DO j=1,6
695 w6(j,i) = w6(j,i)+mv6(j,k)
696 END DO
697 END DO
698C
699 IF(nspmd > 1) THEN
700C
701 CALL my_barrier()
702C
703 IF(itask==0) THEN ! communication on the first thread
704 SIZE = 1
705 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
706C
707C Echange DIAG_SMS
708C
709 CALL spmd_exch_sms6(
710 . w6,nodxi_sms,iad_elem ,fr_elem,SIZE,
711 . lenr)
712 END IF
713C
714 END IF
715C
716 CALL my_barrier()
717C
718 DO n=nodft1_sms,nodlt1_sms
719 i=indx1_sms(n)
720 diag_sms(i) = w6(1,i)+w6(2,i)+w6(3,i)
721 . +w6(4,i)+w6(5,i)+w6(6,i)
722 END DO
723C
724 END IF
725C-----------------------------------------------
726C
727 CALL my_barrier
728C
729 DO n=nodft,nodlt
730 IF(tagslv_rby_sms(n)==0) diag_sms(n) = ms(n)+diag_sms(n)
731 END DO
732C
733 CALL my_barrier
734C
735 DEALLOCATE(nod2add)
736 DEALLOCATE(kadi_sms)
737 DEALLOCATE(nadi_sms)
738
739 RETURN
740 END
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:226
sms_build_diag
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)
Definition sms_build_diag.F:57
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