1 | MODULE transfer_unstructured_mod |
---|
2 | USE data_unstructured_mod |
---|
3 | IMPLICIT NONE |
---|
4 | SAVE |
---|
5 | PRIVATE |
---|
6 | |
---|
7 | #include "unstructured.h90" |
---|
8 | |
---|
9 | INCLUDE 'mpif.h' |
---|
10 | |
---|
11 | LOGICAL :: transfer_initialized=.FALSE. |
---|
12 | PUBLIC :: update_halo |
---|
13 | |
---|
14 | CONTAINS |
---|
15 | |
---|
16 | SUBROUTINE init_halo_transfer(halo, rank, num, cells) |
---|
17 | TYPE(Halo_transfer) :: halo |
---|
18 | INTEGER :: ranks, total, rank(:), num(:), cells(:) |
---|
19 | ranks=SIZE(rank) |
---|
20 | total=SIZE(cells) |
---|
21 | IF(total /= SUM(num) ) STOP 'init_halo_transfer : SIZE(cells)<>SUM(num)' |
---|
22 | halo%ranks = ranks |
---|
23 | ALLOCATE(halo%rank(ranks)) |
---|
24 | ALLOCATE(halo%num(ranks)) |
---|
25 | ALLOCATE(halo%cells(total)) |
---|
26 | ALLOCATE(halo%buf2(llm+1,total)) |
---|
27 | halo%rank=rank |
---|
28 | halo%num=num |
---|
29 | halo%cells=cells |
---|
30 | END SUBROUTINE init_halo_transfer |
---|
31 | |
---|
32 | SUBROUTINE init_transfer(index, & |
---|
33 | send_num, send_size, send_rank, send_len, send_list, & |
---|
34 | recv_num, recv_size, recv_rank, recv_len, recv_list) & |
---|
35 | BIND(C, name='dynamico_init_transfer') |
---|
36 | INTEGER(C_INT), VALUE :: index, send_num, send_size, recv_num, recv_size |
---|
37 | INTEGER(C_INT) :: send_rank(send_num), send_len(send_num), send_list(send_size), & |
---|
38 | recv_rank(recv_num), recv_len(recv_num), recv_list(recv_size) |
---|
39 | IF(debug_on) PRINT *, 'init_transfer', index, & |
---|
40 | send_num, send_size, '/', send_rank, '/', send_len, '/', & |
---|
41 | recv_num, recv_size, '/', recv_rank, '/', recv_len, '/' |
---|
42 | CALL init_halo_transfer(send_info(index), send_rank, send_len, send_list) |
---|
43 | CALL init_halo_transfer(recv_info(index), recv_rank, recv_len, recv_list) |
---|
44 | transfer_initialized=.TRUE. |
---|
45 | END SUBROUTINE init_transfer |
---|
46 | |
---|
47 | !-------------------------------------------------------------------------------------------------! |
---|
48 | |
---|
49 | SUBROUTINE copy_in(lldata, ndata, llbuf, nbuf, cells, data, buf) |
---|
50 | INTEGER :: ndata, lldata, nbuf, llbuf, cells(nbuf), i |
---|
51 | NUM :: data(lldata,ndata), buf(llbuf,nbuf) |
---|
52 | !$OMP DO |
---|
53 | DO i=1,nbuf |
---|
54 | buf(1:lldata,i) = data(1:lldata, cells(i)) |
---|
55 | END DO |
---|
56 | !$OMP END DO |
---|
57 | END SUBROUTINE copy_in |
---|
58 | |
---|
59 | SUBROUTINE copy_out(lldata, ndata, llbuf, nbuf, cells, data, buf) |
---|
60 | INTEGER :: ndata, lldata, nbuf, llbuf, cells(nbuf), i |
---|
61 | NUM :: data(lldata,ndata), buf(llbuf,nbuf) |
---|
62 | !$OMP DO SCHEDULE(STATIC) |
---|
63 | DO i=1,nbuf |
---|
64 | data(1:lldata, cells(i)) = buf(1:lldata,i) |
---|
65 | END DO |
---|
66 | !$OMP END DO |
---|
67 | END SUBROUTINE copy_out |
---|
68 | |
---|
69 | SUBROUTINE update_halo(index, data) |
---|
70 | INTEGER :: index ! transfer_XXX, cf data_unstructured.F90 |
---|
71 | NUM :: data(:,:) |
---|
72 | TYPE(Halo_transfer), POINTER :: halo |
---|
73 | NUM, POINTER :: buf(:,:) |
---|
74 | INTEGER :: req(send_info(index)%ranks+recv_info(index)%ranks), & |
---|
75 | status(MPI_STATUS_SIZE, send_info(index)%ranks+recv_info(index)%ranks) |
---|
76 | INTEGER :: llbuf, num, i, istart, ireq, ierr |
---|
77 | IF(.NOT. transfer_initialized) RETURN |
---|
78 | CALL enter_trace(id_halo, 0) |
---|
79 | halo => send_info(index) |
---|
80 | buf => halo%buf2 |
---|
81 | llbuf = SIZE(buf,1) |
---|
82 | CALL copy_in(SIZE(data,1), SIZE(data,2), llbuf, SIZE(buf,2), halo%cells, data, buf) |
---|
83 | |
---|
84 | !$OMP MASTER |
---|
85 | ireq=0 |
---|
86 | istart=1 |
---|
87 | DO i = 1,halo%ranks |
---|
88 | num = halo%num(i) |
---|
89 | ireq = ireq+1 |
---|
90 | call MPI_ISEND(buf(1,istart), llbuf*num, MPI_NUM, halo%rank(i), & |
---|
91 | 42, MPI_COMM_WORLD, req(ireq), ierr) |
---|
92 | istart = istart+num |
---|
93 | END DO |
---|
94 | !$OMP END MASTER |
---|
95 | halo => recv_info(index) |
---|
96 | buf => halo%buf2 |
---|
97 | llbuf = SIZE(buf,1) |
---|
98 | !$OMP MASTER |
---|
99 | istart=1 |
---|
100 | DO i = 1,halo%ranks |
---|
101 | num = halo%num(i) |
---|
102 | ireq = ireq+1 |
---|
103 | call MPI_IRECV(buf(1,istart), llbuf*num, MPI_NUM, halo%rank(i), & |
---|
104 | 42, MPI_COMM_WORLD, req(ireq), ierr) |
---|
105 | istart = istart+num |
---|
106 | END DO |
---|
107 | CALL MPI_WAITALL(ireq, req, status, ierr) |
---|
108 | !$OMP END MASTER |
---|
109 | !$OMP BARRIER |
---|
110 | |
---|
111 | CALL copy_out(SIZE(data,1), SIZE(data,2), SIZE(buf,1), SIZE(buf,2), halo%cells, data, buf) |
---|
112 | CALL enter_trace(id_halo, 0) |
---|
113 | END SUBROUTINE update_halo |
---|
114 | |
---|
115 | SUBROUTINE update_halo_c(index, lldata, ndata, data) BIND(C, name='dynamico_update_halo') |
---|
116 | INTEGER, VALUE :: index, lldata, ndata |
---|
117 | NUM :: data(lldata, ndata) |
---|
118 | CALL update_halo(index, data) |
---|
119 | END SUBROUTINE update_halo_c |
---|
120 | |
---|
121 | END MODULE transfer_unstructured_mod |
---|