FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_adapt_item_sr.f90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2! Copyright (c) 2019 FrontISTR Commons
3! This software is released under the MIT License, see LICENSE.txt
4!-------------------------------------------------------------------------------
6
8contains
9 !C
10 !C***
11 !C*** hecmw_adapt_ITEM_SEND_RECV
12 !C***
13 !C
14 !C exchange IMPORT/EXPORT item information
15 !C form communication table
16 !C
18 & ( n, neibpetot, neibpe, stack_import, nod_import, &
19 & stack_export, nod_export, &
20 & ws, wr, solver_comm, my_rank, ntab)
21
22 use hecmw_util
23
24 integer(kind=kint ), intent(in) :: N, NEIBPETOT
25 integer(kind=kint ), pointer :: NEIBPE (:)
26 integer(kind=kint ), pointer :: STACK_IMPORT(:)
27 integer(kind=kint ), pointer :: STACK_EXPORT(:)
28 integer(kind=kint ), pointer :: NOD_IMPORT(:), NOD_EXPORT(:)
29
30 integer(kind=kint ), dimension(N*NTAB) :: WS, WR
31 integer(kind=kint ), :: SOLVER_COMM, my_rank
32
33 integer(kind=kint ), dimension(:,:), save, allocatable :: sta1
34 integer(kind=kint ), dimension(:,:), save, allocatable :: sta2
35 integer(kind=kint ), dimension(: ), save, allocatable :: req1
36 integer(kind=kint ), dimension(: ), save, allocatable :: req2
37
38 integer(kind=kint ), save :: NFLAG
39 data nflag/0/
40
41 !C
42 !C-- INIT.
43 if (nflag.eq.0) then
44 allocate (sta1(mpi_status_size,neibpetot))
45 allocate (sta2(mpi_status_size,neibpetot))
46 allocate (req1(neibpetot))
47 allocate (req2(neibpetot))
48 nflag= 1
49 endif
50
51 !C
52 !C-- SEND
53 do neib= 1, neibpetot
54 istart= stack_import(neib-1)
55 inum = stack_import(neib ) - istart
56 do k= istart+1, istart+inum
57 is= (k-1)*ntab
58 do jj= 1, ntab
59 ws(is+jj)= nod_import(is+jj)
60 enddo
61 enddo
62 is= istart*ntab
63 call mpi_isend (ws(is+1), ntab*inum, mpi_integer, &
64 & neibpe(neib), 0, solver_comm, &
65 & req1(neib), ierr)
66 enddo
67
68 !C
69 !C-- RECEIVE
70 do neib= 1, neibpetot
71 istart= stack_export(neib-1)
72 inum = stack_export(neib ) - istart
73 is= istart*ntab
74 call mpi_irecv (wr(is+1), ntab*inum, mpi_integer, &
75 & neibpe(neib), 0, solver_comm, &
76 & req2(neib), ierr)
77 enddo
78
79 call mpi_waitall (neibpetot, req2, sta2, ierr)
80
81 do neib= 1, neibpetot
82 istart= stack_export(neib-1)
83 inum = stack_export(neib ) - istart
84 do k= istart+1, istart+inum
85 is= (k-1)*ntab
86 do jj= 1, ntab
87 nod_export(is+jj)= wr(is+jj)
88 enddo
89 enddo
90 enddo
91
92 call mpi_waitall (neibpetot, req1, sta1, ierr)
93
94 end subroutine hecmw_adapt_item_send_recv
95end module hecmw_adapt_item_sr
96
97
98
Adaptive Mesh Refinement.
subroutine hecmw_adapt_item_send_recv(n, neibpetot, neibpe, stack_import, nod_import, stack_export, nod_export, ws, wr, solver_comm, my_rank, ntab)
I/O and Utility.
Definition: hecmw_util_f.F90:7