[681] | 1 | MODULE transfer_unstructured_mod |
---|
| 2 | USE data_unstructured_mod |
---|
| 3 | IMPLICIT NONE |
---|
| 4 | SAVE |
---|
| 5 | PRIVATE |
---|
| 6 | |
---|
[688] | 7 | #include "unstructured.h90" |
---|
| 8 | |
---|
[681] | 9 | INCLUDE 'mpif.h' |
---|
[684] | 10 | |
---|
| 11 | LOGICAL :: transfer_initialized=.FALSE. |
---|
[681] | 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) |
---|
[802] | 39 | IF(debug_on) PRINT *, 'init_transfer', index, & |
---|
[681] | 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) |
---|
[684] | 44 | transfer_initialized=.TRUE. |
---|
[681] | 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 |
---|
[688] | 51 | NUM :: data(lldata,ndata), buf(llbuf,nbuf) |
---|
[681] | 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 |
---|
[688] | 61 | NUM :: data(lldata,ndata), buf(llbuf,nbuf) |
---|
[681] | 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 |
---|
[688] | 71 | NUM :: data(:,:) |
---|
[681] | 72 | TYPE(Halo_transfer), POINTER :: halo |
---|
[688] | 73 | NUM, POINTER :: buf(:,:) |
---|
[681] | 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 |
---|
[684] | 77 | IF(.NOT. transfer_initialized) RETURN |
---|
[700] | 78 | CALL enter_trace(id_halo, 0) |
---|
[681] | 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 |
---|
[688] | 90 | call MPI_ISEND(buf(1,istart), llbuf*num, MPI_NUM, halo%rank(i), & |
---|
[681] | 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 |
---|
[688] | 103 | call MPI_IRECV(buf(1,istart), llbuf*num, MPI_NUM, halo%rank(i), & |
---|
[681] | 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) |
---|
[700] | 112 | CALL enter_trace(id_halo, 0) |
---|
[681] | 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 |
---|
[688] | 117 | NUM :: data(lldata, ndata) |
---|
[681] | 118 | CALL update_halo(index, data) |
---|
| 119 | END SUBROUTINE update_halo_c |
---|
| 120 | |
---|
| 121 | END MODULE transfer_unstructured_mod |
---|