OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i8tool.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!|| spmd_i8_iloc ../engine/source/mpi/interfaces/spmd_i8tool.F
25!||--- called by ------------------------------------------------------
26!|| intvo8 ../engine/source/interfaces/inter3d/intvo8.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| int8_mod ../common_source/modules/interfaces/int8_mod.F90
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_i8_iloc(ILOC ,MSR,ITAB,BUFFER,
33 . DISTANCE)
34C-----------------------------------------------
35C I n f o r m a t i o n s
36C-----------------------------------------------
37C This routine computes the global
38C ILOCS (i.e. main nodes of each secnd).
39C At the end of this routine, only one
40C processor will have ILOCS(i) > 0
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE int8_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48 USE spmd_comm_world_mod, ONLY : spmd_comm_world
49#include "implicit_f.inc"
50C-----------------------------------------------
51C M e s s a g e P a s s i n g
52C-----------------------------------------------
53#include "spmd.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "task_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER :: MSR(*), ILOC(*), ITAB(*)
63 my_real :: distance(*)
64 TYPE(buft8) BUFFER(*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68#ifdef MPI
69 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFR_ID,BUFS_ID
70 my_real, DIMENSION(:), ALLOCATABLE :: bufr_dist,bufs_dist
71 INTEGER I,J,K,N,P,IERR,K1,K2
72 INTEGER RQS(2*(NSPMD-1))
73 INTEGER RQR1(NSPMD-1)
74 INTEGER RQR2(NSPMD-1)
75 INTEGER STAT(MPI_STATUS_SIZE,2*(NSPMD-1))
76 INTEGER STAT2(MPI_STATUS_SIZE)
77 INTEGER TAG
78 INTEGER TAB_RANK(NSPMD-1),TAB_BUFPOS(NSPMD-1)
79 INTEGER BUFLEN,BUFPOS,RMAX_UID_LOCAL,RMAX_UID_REMOTE
80 my_real dist1,dist2
81 INTEGER MSGOFF,MSGOFF2
82 DATA msgoff/15000/
83 DATA msgoff2/15001/
84
85C-----------------------------------------------
86C S o u r c e L i n e s
87C-----------------------------------------------
88 buflen=0
89 DO i = 1,nspmd
90 IF(i-1 /=ispmd) THEN
91 buflen = buflen+buffer(i)%NBSECND_TOT
92 ENDIF
93 ENDDO
94 ALLOCATE(bufr_id(buflen))
95 ALLOCATE(bufs_id(buflen))
96 ALLOCATE(bufr_dist(buflen))
97 ALLOCATE(bufs_dist(buflen))
98 bufr_id(1:buflen) = 0
99 bufs_id(1:buflen) = 0
100 bufr_dist(1:buflen) = 0
101 bufs_dist(1:buflen) = 0
102 k = 0
103 k1= 0
104 k2= 0
105 bufpos = 1
106 DO i = 1,nspmd
107 IF( ispmd /= i-1) THEN
108 DO j = 1,buffer(i)%NBSECND_TOT
109 n = buffer(i)%SECND_ID(j)
110C BUFFER(I)%DISTANCE(J) = DISTANCE(N)
111 bufs_dist(bufpos + j -1) = distance(n)
112C BUFFER(I)%NEW_MAIN_UID(J) = ITAB(MSR(ILOC(N)))
113 bufs_id(bufpos + j -1) = itab(msr(iloc(n)))
114
115 ENDDO
116 n = buffer(i)%NBSECND_TOT
117 ! the number of secnds on the frontier has
118 ! to be the same on each side of the frontier
119 IF( n > 0 ) THEN
120 k = k + 1
121 k1=k1 + 1
122
123 tab_rank(k1) = i
124 tab_bufpos(k1) = bufpos
125 tag = msgoff
126
127 CALL mpi_isend(bufs_id(bufpos),n,
128 . mpi_int,i-1,tag,spmd_comm_world,rqs(k),ierr)
129 CALL mpi_irecv(bufr_id(bufpos),n,
130 . mpi_int,i-1,tag,spmd_comm_world,rqr1(k1),ierr)
131
132 tag = msgoff2
133 k = k + 1
134 k2=k2 + 1
135 CALL mpi_isend(bufs_dist(bufpos),n,
136 . real,i-1,tag,spmd_comm_world,rqs(k),ierr)
137 CALL mpi_irecv(bufr_dist(bufpos),n,
138 . real,i-1,tag,spmd_comm_world,rqr2(k2),ierr)
139 bufpos = bufpos + n
140 ENDIF
141 ENDIF
142 ENDDO
143
144 ierr=-999
145 IF(k > 0) CALL mpi_waitall(k, rqs,stat,ierr)
146 bufpos = 0
147 DO p = 1,k1
148 CALL mpi_waitany(k2,rqr2,i,stat,ierr)
149 CALL mpi_wait(rqr1(i),stat2,ierr)
150 bufpos = tab_bufpos(i) - 1
151 i = tab_rank(i)
152 IF(ispmd /= i-1) THEN
153 n = buffer(i)%NBSECND_TOT
154 DO j = 1,n
155 k = buffer(i)%SECND_ID(j)
156C DIST1 = DISTANCE(K)
157 dist1 = bufs_dist(bufpos+j)
158 dist2 = bufr_dist(bufpos+j)
159 rmax_uid_remote=bufr_id(bufpos+j)
160
161 !IF ISPMD STILL HAS THE SECND
162 IF(iloc(k) > 0) THEN
163 rmax_uid_local = itab(msr(iloc(k)))
164 IF(dist1 > dist2 .OR.
165 . (dist1 == dist2 .AND. rmax_uid_local > rmax_uid_remote) .OR.
166 . (rmax_uid_local == rmax_uid_remote .AND. i-1 < ispmd)) THEN
167! IF the main remote is closer than the main local
168! OR the distance is the same, but the user id of the remote
169! main is lower
170! or the user id of the main remote is the same than the local
171! main (i.e. the new main is also on the boundary between i-1
172! and ISPMD, but ISPMD > i-1
173! THEN we remove the secnd (it will be kept by the Proc i-1)
174 distance(k)=dist2
175 iloc(k)= -1
176! Here, the secnd will
177! not have a new main internal to the ISPMD
178! Still it can be put at the boundary of ISPMD by another
179! process
180 ENDIF
181 ENDIF
182 ENDDO
183 bufpos = bufpos + n
184 ENDIF
185 ENDDO
186
187! CALL MPI_BARRIER(SPMD_COMM_WORLD,ierr)
188 DEALLOCATE(bufr_id,bufs_id)
189 DEALLOCATE(bufr_dist,bufs_dist)
190#endif
191 END SUBROUTINE
192!||====================================================================
193!|| spmd_i8_index ../engine/source/mpi/interfaces/spmd_i8tool.F
194!||--- called by ------------------------------------------------------
195!|| intvo8 ../engine/source/interfaces/inter3d/intvo8.F
196!||--- uses -----------------------------------------------------
197!|| int8_mod ../common_source/modules/interfaces/int8_mod.F90
198!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
199!||====================================================================
200 SUBROUTINE spmd_i8_index(NMN,FRONTIER,INDEX_IN_COMM,S_COMM)
201C-----------------------------------------------
202C I n f o r m a t i o n s
203C-----------------------------------------------
204C Computes INDEX_IN_COMM such that
205C if I is the main local id
206C INDEX_IN_COMM(i) =
207C index of the node in
208C Communication structure
209C 0 if the node is not
210C shared between processors (considering only this
211C interface)
212C-----------------------------------------------
213C M o d u l e s
214C-----------------------------------------------
215 USE int8_mod
216C-----------------------------------------------
217C I m p l i c i t T y p e s
218C-----------------------------------------------
219 USE spmd_comm_world_mod, ONLY : spmd_comm_world
220#include "implicit_f.inc"
221C-----------------------------------------------
222C D u m m y A r g u m e n t s
223C-----------------------------------------------
224 INTEGER :: NMN,S_COMM
225 INTEGER :: INDEX_IN_COMM(NMN)
226 TYPE(front8) FRONTIER(*)
227C-----------------------------------------------
228C L o c a l V a r i a b l e s
229C-----------------------------------------------
230 INTEGER I
231C-----------------------------------------------
232C S o u r c e L i n e s
233C-----------------------------------------------
234 index_in_comm(1:nmn) = 0
235 DO i = 1,s_comm
236 index_in_comm(frontier(i)%NUMLOC) = i
237 ENDDO
238
239 END SUBROUTINE
240!||====================================================================
241!|| spmd_i8_commslv ../engine/source/mpi/interfaces/spmd_i8tool.F
242!||--- called by ------------------------------------------------------
243!|| intvo8 ../engine/source/interfaces/inter3d/intvo8.F
244!||--- calls -----------------------------------------------------
245!||--- uses -----------------------------------------------------
246!|| int8_mod ../common_source/modules/interfaces/int8_mod.F90
247!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
248!||====================================================================
249 SUBROUTINE spmd_i8_commslv(NBSECNDS,ILOC,NSV,
250 . ITAB,BUFFER,FRONTIER,INDEX_IN_COMM)
251C-----------------------------------------------
252C I n f o r m a t i o n s
253C-----------------------------------------------
254C Each processor communicates a
255C secnd nodes that has a main nodes that is shared
256C with another processor
257C-----------------------------------------------
258C M o d u l e s
259C-----------------------------------------------
260 USE int8_mod
261C-----------------------------------------------
262C I m p l i c i t T y p e s
263C-----------------------------------------------
264 USE spmd_comm_world_mod, ONLY : spmd_comm_world
265#include "implicit_f.inc"
266C-----------------------------------------------
267C M e s s a g e P a s s i n g
268C-----------------------------------------------
269#include "spmd.inc"
270C-----------------------------------------------
271C C o m m o n B l o c k s
272C-----------------------------------------------
273#include "com01_c.inc"
274#include "task_c.inc"
275C-----------------------------------------------
276C D u m m y A r g u m e n t s
277C-----------------------------------------------
278 INTEGER :: NSV(*), ILOC(*), ITAB(*)
279 INTEGER :: NBSECNDS,INDEX_IN_COMM(*)
280 TYPE(front8) FRONTIER(*)
281 TYPE(buft8) BUFFER(*)
282C-----------------------------------------------
283C L o c a l V a r i a b l e s
284C-----------------------------------------------
285#ifdef MPI
286 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFR_ID,BUFR_IDR
287 INTEGER I,J,K,L,N,P,IERR
288 INTEGER RQS(2*(NSPMD-1))
289 INTEGER RQR(2*(NSPMD-1))
290 INTEGER KSENT,KRECV
291 INTEGER STAT(MPI_STATUS_SIZE,2*(NSPMD-1))
292 INTEGER TAG,NB_SECND_SENT(NSPMD),NB_SECND_RECV(NSPMD)
293 INTEGER NB_SECND_TOT
294 INTEGER BUFLEN,BUFPOS(NSPMD),RMAX_UID_LOCAL,RMAX_UID_REMOTE
295 INTEGER IMAIN,ISECND
296 INTEGER MSGOFF,MSGOFF2
297 DATA msgoff/15002/
298 DATA msgoff2/15003/
299
300C-----------------------------------------------
301C S o u r c e L i n e s
302C-----------------------------------------------
303 nb_secnd_sent(1:nspmd) = 0
304 nb_secnd_tot = 0
305 DO i = 1,nbsecnds
306 ! if the secnd is active, and its main is in the frontier
307 IF(iloc(i) > 0) THEN
308 IF(index_in_comm(iloc(i))>0)THEN
309 k = index_in_comm(iloc(i))
310 DO j = 1,frontier(k)%NBCOM
311 p = frontier(k)%PROCLIST(j)
312 nb_secnd_sent(p) = nb_secnd_sent(p) + 1
313 nb_secnd_tot = nb_secnd_tot +1
314 ENDDO
315 ENDIF
316 ENDIF
317 ENDDO
318
319
320 ALLOCATE(bufr_id(nb_secnd_tot*2))
321
322
323 bufpos = 0
324 bufpos(1) = 1
325 DO i = 1,nspmd-1
326 bufpos(i+1) = 2*nb_secnd_sent(i) + bufpos(i)
327 ENDDO
328
329
330 DO i = 1,nbsecnds
331 ! if the secnd is active, and its main is in the frontier
332 IF(iloc(i)>0) THEN
333 IF(index_in_comm(iloc(i))>0)THEN
334 k = index_in_comm(iloc(i))
335 DO j = 1,frontier(k)%NBCOM
336 p = frontier(k)%PROCLIST(j)
337 n = frontier(k)%BUF_INDEX(j)
338 ! we have to send the secnd uid and the position in the
339 ! frontier
340 ! this position is also the position in the remote domain
341 bufr_id(bufpos(p)) = itab(nsv(i))
342 bufr_id(bufpos(p)+1) = n
343 bufpos(p) = bufpos(p) + 2
344 ENDDO
345 ENDIF
346 ENDIF
347 ENDDO
348
349 nb_secnd_recv(1:nspmd) = 0
350 k = 1
351 n = 1
352
353 tag = msgoff
354 k = 0
355 DO i = 1,nspmd
356 ! if ispmd shares main nodes with i
357 ! then send the number of secnd to exchange
358C WRITE(6,*) __FILE__,__LINE__,ISPMD,I-1
359 IF(ispmd /= i-1 .AND.buffer(i)%NBMAIN >0 ) THEN
360 k = k +1
361 CALL mpi_isend(nb_secnd_sent(i),1,
362 . mpi_int,i-1,tag,spmd_comm_world,rqs(k),ierr)
363 CALL mpi_irecv(nb_secnd_recv(i),1,
364 . mpi_int,i-1,tag,spmd_comm_world,rqr(k),ierr)
365 ENDIF
366 ENDDO
367
368 IF( k > 0 ) CALL mpi_waitall(k,rqr,stat,ierr)
369
370
371 ! size of reception buffer
372 buflen = 0
373 DO i = 1,nspmd
374 IF(ispmd /= i-1) THEN
375 buflen = buflen + nb_secnd_recv(i)
376 ENDIF
377 ENDDO
378 !write(6,*) __file__,__line__,"nbsr(:)=",nb_secnd_recv(1:nspmd)
379 ALLOCATE(bufr_idr(buflen*2))
380
381 IF( k > 0 ) CALL mpi_waitall(k, rqs,stat,ierr)
382
383
384 tag = msgoff2
385 k = 1
386 l = 1
387 ksent = 0
388 krecv = 0
389 !send the data corresponding of the secnds to exchange
390 DO i = 1,nspmd
391 IF(ispmd /= i-1) THEN
392 j = nb_secnd_sent(i)*2
393 IF(j > 0) THEN
394 ksent = ksent + 1
395 CALL mpi_isend(bufr_id(n),j,
396 . mpi_int,i-1,tag,spmd_comm_world,rqs(ksent),ierr)
397 n = n + j
398 ENDIF
399 j = nb_secnd_recv(i)*2
400 IF(j > 0) THEN
401 krecv = krecv + 1
402 CALL mpi_irecv(bufr_idr(l),j,
403 . mpi_int,i-1,tag,spmd_comm_world,rqr(krecv),ierr)
404 l = l + j
405 ENDIF
406 ENDIF
407 ENDDO
408
409 IF(ksent > 0 ) CALL mpi_waitall(ksent, rqs,stat,ierr)
410 IF(krecv > 0 ) CALL mpi_waitall(krecv, rqr,stat,ierr)
411
412!
413 k = 1
414 l = 1
415 n = 1
416 !In the following we suppose that only one SPMD domain
417 !has a secnd activated
418 DO isecnd=1,nbsecnds
419 rmax_uid_local = itab(nsv(isecnd))
420 DO i = 1,nspmd
421 IF(ispmd /= i-1) THEN
422 j = nb_secnd_recv(i)
423 IF(j > 0) THEN
424 ! if ISPMD receives secnds from proc I
425 ! then find out if one these secnds is ISECND
426 ! using user ids.
427 DO k = l,l+j-1
428 rmax_uid_remote = bufr_idr(2*k-1)
429 IF(rmax_uid_local == rmax_uid_remote) THEN
430 imain = bufr_idr(2*k)
431 iloc(isecnd) = buffer(i)%MAIN_ID(imain)
432 ENDIF
433 ENDDO
434 ENDIF
435 l = l + j
436 ENDIF !ISPMD
437 ENDDO !ISPMD
438 l = 1
439 ENDDO
440
441 DEALLOCATE(bufr_id)
442 DEALLOCATE(bufr_idr)
443#endif
444 END SUBROUTINE
445
446!||====================================================================
447!|| spmd_i8_updbuf ../engine/source/mpi/interfaces/spmd_i8tool.F
448!||--- called by ------------------------------------------------------
449!|| intvo8 ../engine/source/interfaces/inter3d/intvo8.F
450!||--- uses -----------------------------------------------------
451!|| int8_mod ../common_source/modules/interfaces/int8_mod.F90
452!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
453!||====================================================================
454 SUBROUTINE spmd_i8_updbuf(NBSECNDS,ILOC,NSV,
455 . ITAB,BUFFER,FRONTIER,INDEX_IN_COMM)
456C-----------------------------------------------
457C I n f o r m a t i o n s
458C-----------------------------------------------
459C Update the buffer structure that contains
460C the secnd nodes that have a main node
461C which is shared by at least another processor
462C-----------------------------------------------
463C M o d u l e s
464C-----------------------------------------------
465 USE int8_mod
466C-----------------------------------------------
467C I m p l i c i t T y p e s
468C-----------------------------------------------
469 USE spmd_comm_world_mod, ONLY : spmd_comm_world
470#include "implicit_f.inc"
471C-----------------------------------------------
472C C o m m o n B l o c k s
473C-----------------------------------------------
474#include "com01_c.inc"
475#include "task_c.inc"
476C-----------------------------------------------
477C D u m m y A r g u m e n t s
478C-----------------------------------------------
479 INTEGER :: NSV(*), ILOC(*), ITAB(*)
480 INTEGER :: INDEX_IN_COMM(*)
481 INTEGER :: NBSECNDS
482 TYPE(front8) FRONTIER(*)
483 TYPE(buft8) BUFFER(*)
484C-----------------------------------------------
485C L o c a l V a r i a b l e s
486C-----------------------------------------------
487 INTEGER I,J,K,N,P
488 INTEGER PT(NSPMD)
489
490
491#ifdef MPI
492 !compute the number of secnd nodes per frontier main node
493 DO p = 1,nspmd
494 IF(ispmd /= p-1) THEN
495 buffer(p)%NBSECND = 0
496 ENDIF
497 ENDDO
498 DO i = 1,nbsecnds
499 ! If the secnd is active, and its main is in the frontier
500 IF(iloc(i)>0) THEN
501 IF(index_in_comm(iloc(i))>0)THEN
502 k = index_in_comm(iloc(i))
503 DO j = 1,frontier(k)%NBCOM
504 p = frontier(k)%PROCLIST(j)
505 n = frontier(k)%BUF_INDEX(j)
506 buffer(p)%NBSECND(n) = buffer(p)%NBSECND(n) + 1
507 ENDDO
508 ENDIF
509 ENDIF
510 ENDDO
511
512 DO i =1, nspmd
513 ! compute the global number of secnd nodes to send to proc i
514 buffer(i)%NBSECND_TOT = 0
515 DO j = 1,buffer(i)%NBMAIN
516 buffer(i)%NBSECND_TOT = buffer(i)%NBSECND_TOT +
517 . buffer(i)%NBSECND(j)
518 ENDDO
519C IF(ASSOCIATED(BUFFER(I)%SECND_UID)) THEN
520C
521 DEALLOCATE(buffer(i)%SECND_UID)
522 DEALLOCATE(buffer(i)%SECND_ID)
523C DEALLOCATE(BUFFER(I)%NEW_MAIN_UID)
524C DEALLOCATE(BUFFER(I)%DISTANCE)
525C DEALLOCATE(BUFFER(I)%BUFR)
526C DEALLOCATE(BUFFER(I)%BUFI)
527C ENDIF
528 ALLOCATE(buffer(i)%SECND_UID(buffer(i)%NBSECND_TOT))
529 ALLOCATE(buffer(i)%SECND_ID(buffer(i)%NBSECND_TOT))
530C ALLOCATE(BUFFER(I)%NEW_MAIN_UID(BUFFER(I)%NBSECND_TOT))
531C ALLOCATE(BUFFER(I)%DISTANCE(BUFFER(I)%NBSECND_TOT))
532C ALLOCATE(BUFFER(I)%BUFR(BUFFER(I)%NBSECND_TOT*2))
533C ALLOCATE(BUFFER(I)%BUFI(BUFFER(I)%NBSECND_TOT*9))
534C BUFFER(I)%BUFR(1:BUFFER(I)%NBSECND_TOT)=0
535C BUFFER(I)%BUFI(1:BUFFER(I)%NBSECND_TOT)=0
536 ENDDO
537
538 ! Fill the buffer of secnd uid to send
539 pt = 0
540 DO i = 1,nbsecnds
541 ! if the secnd is active, and its main is in the frontier
542 IF(iloc(i) > 0) THEN
543 IF(index_in_comm(iloc(i)) > 0)THEN
544 k = index_in_comm(iloc(i))
545 DO j = 1,frontier(k)%NBCOM
546 p = frontier(k)%PROCLIST(j)
547 n = frontier(k)%BUF_INDEX(j)
548 pt(p) = pt(p) + 1
549 buffer(p)%SECND_ID(pt(p)) = i
550 buffer(p)%SECND_UID(pt(p)) = itab(nsv(i))
551
552 ENDDO
553 ENDIF
554 ENDIF
555 ENDDO
556#endif
557 END SUBROUTINE
558
559
560!||====================================================================
561!|| spmd_i8_irtl ../engine/source/mpi/interfaces/spmd_i8tool.F
562!||--- called by ------------------------------------------------------
563!|| intvo8 ../engine/source/interfaces/inter3d/intvo8.F
564!||--- calls -----------------------------------------------------
565!|| is_sup_face_id ../engine/source/interfaces/inter3d/is_sup_face_id.F
566!||--- uses -----------------------------------------------------
567!|| int8_mod ../common_source/modules/interfaces/int8_mod.F90
568!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
569!||====================================================================
570 SUBROUTINE spmd_i8_irtl(
571 . IRTL, HAS_MOVED,
572 . TAB_RMAX, TAB_RMAX_UID,
573 . ITAB, BUFFER)
574
575C-----------------------------------------------
576C I n f o r m a t i o n s
577C-----------------------------------------------
578C This routine computes the global
579C IRTL (i.e. main face of each secnd).
580C At the end of this routine, only one processor
581C will have IRTL(i) /= 0.
582C-----------------------------------------------
583C M o d u l e s
584C-----------------------------------------------
585 USE int8_mod
586C-----------------------------------------------
587C I m p l i c i t T y p e s
588C-----------------------------------------------
589 USE spmd_comm_world_mod, ONLY : spmd_comm_world
590#include "implicit_f.inc"
591C-----------------------------------------------
592C M e s s a g e P a s s i n g
593C-----------------------------------------------
594#include "spmd.inc"
595C-----------------------------------------------
596C C o m m o n B l o c k s
597C-----------------------------------------------
598#include "com01_c.inc"
599#include "task_c.inc"
600C-----------------------------------------------
601C D u m m y A r g u m e n t s
602C-----------------------------------------------
603 INTEGER :: ITAB(*),IRTL(*)
604 INTEGER :: TAB_RMAX_UID(4,*),HAS_MOVED(*)
605 my_real :: TAB_RMAX(*)
606 TYPE(BUFT8) BUFFER(*)
607C-----------------------------------------------
608C L o c a l V a r i a b l e s
609C-----------------------------------------------
610#ifdef MPI
611
612 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFR_ID,BUFS_ID
613 my_real, DIMENSION(:), ALLOCATABLE :: BUFR,BUFS
614 INTEGER I,J,K,N,IERR
615 INTEGER RQS(2*(NSPMD-1))
616 INTEGER RQR(2*(NSPMD-1))
617 INTEGER STAT(MPI_STATUS_SIZE,2*(NSPMD-1))
618 INTEGER TAG
619 INTEGER BUFLEN,IFLAG
620 INTEGER RMAX_UID_LOCAL(4),RMAX_UID_REMOTE(4)
621 INTEGER BUFPOS1,BUFPOS2,HAS_MOVED_ON_REMOTE
622 my_real rmax1,rmax2
623 INTEGER NBRQ
624 INTEGER MSGOFF,MSGOFF2
625C-----------------------------------------------
626C E x t e r n a l F u n c t i o n s
627C-----------------------------------------------
628 INTEGER IS_SUP_FACE_ID
629 EXTERNAL is_sup_face_id
630
631 DATA msgoff/15004/
632 DATA msgoff2/15005/
633
634 !AFTER THE EXCHANGE OF FRONT SECND, AND THE UPDATE OF THE BUFFER
635 !THE SECND AT EACH BOUNDARY ARE SHARED
636 buflen=0
637 DO i = 1,nspmd
638 buflen = buflen+buffer(i)%NBSECND_TOT
639 ENDDO
640
641 ALLOCATE(bufr_id(buflen*5))
642 ALLOCATE(bufr(buflen))
643 ALLOCATE(bufs_id(buflen*5))
644 ALLOCATE(bufs(buflen))
645 bufr_id(1:buflen*5) = 0
646 bufr(1:buflen) = zero
647 bufs_id(1:buflen*5) = 0
648 bufs(1:buflen) = zero
649
650 k = 1
651 bufpos1 = 1
652 bufpos2 = 1
653 nbrq = 0
654 DO i = 1,nspmd
655 IF( ispmd /= i-1) THEN
656 DO j = 1,buffer(i)%NBSECND_TOT
657 n = buffer(i)%SECND_ID(j)
658C
659 bufs(bufpos2 - 1+(j-1)+1) = tab_rmax(n)
660 bufs_id(bufpos1 - 1 + (j-1)*5+1) = tab_rmax_uid(1,n)
661 bufs_id(bufpos1 - 1 + (j-1)*5+2) = tab_rmax_uid(2,n)
662 bufs_id(bufpos1 - 1 + (j-1)*5+3) = tab_rmax_uid(3,n)
663 bufs_id(bufpos1 - 1 + (j-1)*5+4) = tab_rmax_uid(4,n)
664 bufs_id(bufpos1 - 1 + (j-1)*5+5) = has_moved(n)
665
666 ENDDO
667 n = buffer(i)%NBSECND_TOT
668 ! The number of secnds on the frontier has
669 ! to be the same on each side of the frontier
670 IF(n > 0) THEN
671 tag = msgoff
672 nbrq = nbrq + 1
673 CALL mpi_isend(bufs_id(bufpos1),n*5,mpi_int,i-1,tag,spmd_comm_world,rqs(nbrq),ierr)
674 CALL mpi_irecv(bufr_id(bufpos1),n*5,mpi_int,i-1,tag,spmd_comm_world,rqr(nbrq),ierr)
675 bufpos1 = bufpos1 + 5*n
676 tag = msgoff2
677 nbrq = nbrq + 1
678 CALL mpi_isend(bufs(bufpos2),n,real,i-1,tag,spmd_comm_world,rqs(nbrq),ierr)
679 CALL mpi_irecv(bufr(bufpos2),n,real,i-1,tag,spmd_comm_world,rqr(nbrq),ierr)
680 bufpos2 = bufpos2 + n
681 ENDIF
682 ENDIF
683 ENDDO !ISPMD
684 IF(nbrq > 0) THEN
685 CALL mpi_waitall(nbrq, rqs,stat,ierr)
686 CALL mpi_waitall(nbrq, rqr,stat,ierr)
687 ENDIF
688
689 bufpos1 = 0
690 bufpos2 = 0
691
692 DO i = 1,nspmd
693 IF(ispmd /= i-1) THEN
694 n = buffer(i)%NBSECND_TOT
695 DO j = 1,n
696 k = buffer(i)%SECND_ID(j)
697 rmax2 = bufr((j-1)+1+bufpos2)
698 rmax_uid_remote(1) = bufr_id((j-1)*5+1+bufpos1)
699 rmax_uid_remote(2) = bufr_id((j-1)*5+2+bufpos1)
700 rmax_uid_remote(3) = bufr_id((j-1)*5+3+bufpos1)
701 rmax_uid_remote(4) = bufr_id((j-1)*5+4+bufpos1)
702 has_moved_on_remote = bufr_id((j-1)*5+5+bufpos1)
703
704 rmax1 = tab_rmax(k)
705 rmax_uid_local(1) = tab_rmax_uid(1,k)
706 rmax_uid_local(2) = tab_rmax_uid(2,k)
707 rmax_uid_local(3) = tab_rmax_uid(3,k)
708 rmax_uid_local(4) = tab_rmax_uid(4,k)
709
710 iflag = is_sup_face_id(rmax_uid_local,rmax_uid_remote)
711
712 IF(has_moved(k) == 1) THEN
713 ! the main face has changed on the local proc
714 ! or is not on the local proc
715 ! current proc not in charge of the face
716 ! in the following cases
717 IF(has_moved_on_remote == 0) THEN
718 ! the main face has not changed on the remote proc.
719 irtl(k) = 0
720 ELSEIF( rmax1 < rmax2 .OR. (rmax1 == rmax2 .AND. iflag == 1)) THEN
721 irtl(k) = 0
722 ENDIF
723 ENDIF
724 ENDDO
725 bufpos1 = bufpos1 + 5*n
726 bufpos2 = bufpos2 + n
727 ENDIF
728 ENDDO
729 DEALLOCATE(bufr_id,bufs_id)
730 DEALLOCATE(bufr,bufs)
731
732#endif
733
734 END SUBROUTINE
735
736
737!||====================================================================
738!|| spmd_i8_reduce ../engine/source/mpi/interfaces/spmd_i8tool.F
739!||--- called by ------------------------------------------------------
740!|| intfop8 ../engine/source/interfaces/interf/intfop8.F
741!||--- calls -----------------------------------------------------
742!||--- uses -----------------------------------------------------
743!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
744!||====================================================================
745 SUBROUTINE spmd_i8_reduce(TAB,N,NUM)
746C-----------------------------------------------
747C I n f o r m a t i o n s
748C-----------------------------------------------
749C This routine communicates secnd variables
750C (- Flag = 1 : Send) Commented
751C (- Flag = 2 : Receive) Commented
752C - Flag = 3 : Synchrone
753C-----------------------------------------------
754C M o d u l e s
755C-----------------------------------------------
756
757C-----------------------------------------------
758C I m p l i c i t T y p e s
759C-----------------------------------------------
760 USE spmd_comm_world_mod, ONLY : spmd_comm_world
761#include "implicit_f.inc"
762C-----------------------------------------------
763C M e s s a g e P a s s i n g
764C-----------------------------------------------
765#include "spmd.inc"
766C-----------------------------------------------
767C C o m m o n B l o c k s
768C-----------------------------------------------
769#include "task_c.inc"
770C-----------------------------------------------
771C D u m m y A r g u m e n t s
772C-----------------------------------------------
773 my_real :: tab(n)
774 INTEGER :: N
775C INTEGER :: FLAG,RQ(NSPMD)
776C-----------------------------------------------
777C L o c a l V a r i a b l e s
778C-----------------------------------------------
779 INTEGER :: I,J,MSGOFF,TAG,NUM
780 DATA msgoff/15010/
781
782#ifdef MPI
783 INTEGER IERR,POS
784 INTEGER STAT(MPI_STATUS_SIZE)
785 my_real, DIMENSION(:), ALLOCATABLE :: buf
786 tag = msgoff
787c IF(FLAG == 1) THEN
788c POS = 0
789c DO I=1,NSPMD
790c IF(ISPMD /= I-1) THEN
791c POS = POS + 1
792c CALL MPI_ISEND(TAB,N,REAL,I-1,TAG,SPMD_COMM_WORLD,RQ(POS),IERR)
793c ENDIF
794c ENDDO
795c CALL MPI_WAITALL(NSPMD-1,RQ,MPI_STATUSES_IGNORE,IERR)
796c ELSEIF(FLAG ==2) THEN
797c ALLOCATE(BUF(N),STAT=IERR)
798c BUF(1:N) = 0
799c DO I=1,NSPMD
800c IF(ISPMD /= I-1) THEN
801c CALL MPI_RECV(BUF,N,REAL,I-1,TAG,SPMD_COMM_WORLD,IERR)
802c DO J=1,N
803c TAB(J) = TAB(J) + BUF(J)
804c ENDDO
805c ENDIF
806c ENDDO
807c CALL MPI_WAIT(RQ,STAT,IERR)
808c DEALLOCATE(BUF)
809c ELSEIF(FLAG == 3) THEN
810 ALLOCATE(buf(n),stat=ierr)
811 buf(1:n) = tab(1:n)
812 CALL mpi_allreduce(buf,tab,n,real,mpi_sum,
813 . spmd_comm_world,ierr)
814 DEALLOCATE(buf)
815
816
817c ENDIF
818#endif
819 END SUBROUTINE
820
821
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_waitall
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
Definition mpi.f:536
mpi_allreduce
subroutine mpi_allreduce(sendbuf, recvbuf, cnt, datatype, operation, comm, ierr)
Definition mpi.f:103
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
id
initmumps id
Definition multiplerhs_example.m:4
spmd_i8_index
subroutine spmd_i8_index(nmn, frontier, index_in_comm, s_comm)
Definition spmd_i8tool.F:201
spmd_i8_commslv
subroutine spmd_i8_commslv(nbsecnds, iloc, nsv, itab, buffer, frontier, index_in_comm)
Definition spmd_i8tool.F:251
spmd_i8_updbuf
subroutine spmd_i8_updbuf(nbsecnds, iloc, nsv, itab, buffer, frontier, index_in_comm)
Definition spmd_i8tool.F:456
spmd_i8_iloc
subroutine spmd_i8_iloc(iloc, msr, itab, buffer, distance)
Definition spmd_i8tool.F:34
spmd_i8_reduce
subroutine spmd_i8_reduce(tab, n, num)
Definition spmd_i8tool.F:746
spmd_i8_irtl
subroutine spmd_i8_irtl(irtl, has_moved, tab_rmax, tab_rmax_uid, itab, buffer)
Definition spmd_i8tool.F:574
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841