File: /nfs/home/0/users/jenkins/mfix.git/model/dmp_modules/mpi_donothing/sendrecv_mod.f

1     module sendrecv
2       use parallel_mpi
3       use debug
4       use geometry
5       use compar
6       use indices
7       implicit none
8     
9       integer, pointer, dimension(:) :: &
10            recvproc1, recvtag1, xrecv1, recvijk1, &
11            sendproc1, sendtag1, xsend1, sendijk1, &
12            recvproc2, recvtag2, xrecv2, recvijk2, &
13            sendproc2, sendtag2, xsend2, sendijk2
14     
15       integer :: nrecv1,nsend1, nrecv2,nsend2
16       logical,parameter :: localfunc=.true.
17     
18     
19       double precision, dimension(:), allocatable :: &
20            dsendbuffer, drecvbuffer
21       integer, dimension(:), allocatable :: &
22            isendbuffer, irecvbuffer
23       character, dimension(:), pointer :: &
24            csendbuffer, crecvbuffer
25     
26       integer :: nrecv,nsend
27       integer, pointer, dimension(:) :: &
28            recvrequest, sendrequest, &
29            xrecv,recvproc, recvijk, recvtag, &
30            xsend,sendproc, sendijk, sendtag
31     
32       integer :: communicator
33     
34       !       -----------------
35       !       generic interface
36       !       -----------------
37       interface sendrecv_begin
38          module procedure &
39               sendrecv_begin_1d, &
40               sendrecv_begin_1i, &
41               sendrecv_begin_1c
42       end interface sendrecv_begin
43     
44       interface sendrecv_end
45          module procedure &
46               sendrecv_end_1d, &
47               sendrecv_end_1i, &
48               sendrecv_end_1c
49       end interface sendrecv_end
50     
51       interface send_recv
52          module procedure &
53               send_recv_1d, send_recv_2d, send_recv_3d, &
54               send_recv_1i, &
55               send_recv_1c
56       end interface send_recv
57     
58     
59     contains
60     
61       subroutine ijk_of( ijkp, i,j,k )
62         integer, intent(in) :: ijkp
63         integer, intent(out) :: i,j,k
64     
65         integer :: k1,k2, j1,j2, i1,i2, &
66              ijk, isize,jsize,ksize, gijk
67     
68         character(len=32), parameter :: name = "ijk_of"
69         logical :: isok_k, isok_j, isok_i, is_same, isok
70     
71         ijk = ijkp
72     
73         i1 = istart3_all(myPE)
74         i2 = iend3_all(myPE)
75         j1 = jstart3_all(myPE)
76         j2 = jend3_all(myPE)
77         k1 = kstart3_all(myPE)
78         k2 = kend3_all(myPE)
79     
80         ksize = (k2-k1+1)
81         jsize = (j2-j1+1)
82         isize = (i2-i1+1)
83     
84     
85         if (mod(ijk,isize*jsize).ne.0) then
86            k = int( ijk/(isize*jsize) ) + k1
87         else
88            k = int( ijk/(isize*jsize) ) + k1 -1
89         endif
90         ijk = ijk - (k-k1)*(isize*jsize)
91     
92         if (mod(ijk,isize).ne.0) then
93            j = int( ijk/isize ) + j1
94         else
95            j = int( ijk/isize ) + j1 - 1
96         endif
97         ijk = ijk - (j-j1)*isize
98     
99         i = (ijk-1) + i1
100         !       ------------
101         !       double check
102         !       ------------
103         isok_i = (i1 <= i) .and. (i <= i2)
104         isok_j = (j1 <= j) .and. (j <= j2)
105         isok_k = (k1 <= k) .and. (k <= k2)
106         gijk = 1 + (i-i1) + (j-j1)*(i2-i1+1) + &
107              (k-k1)*(j2-j1+1)*(i2-i1+1)
108         is_same = (gijk .eq. ijkp)
109         isok = isok_i .and. isok_j .and. isok_k .and. is_same
110         if (.not.isok) then
111            call write_debug( name, 'i,j,k ', i,j,k )
112            call write_debug( name, 'ijkp, gijk ', ijkp, gijk )
113         endif
114     
115     
116         return
117       end subroutine ijk_of
118     
119     
120       subroutine ijk_of_gl( ijkp, i,j,k )
121         integer, intent(in) :: ijkp
122         integer, intent(out) :: i,j,k
123     
124         integer :: k1,k2, j1,j2, i1,i2, &
125              ijk, isize,jsize,ksize, gijk
126     
127         character(len=32), parameter :: name = "ijk_of_gl"
128         logical :: isok_k, isok_j, isok_i, is_same, isok
129     
130         ijk = ijkp
131     
132         k1 = minval( kstart3_all(:) )
133         k2 = maxval( kend3_all(:) )
134     
135         j1 = minval( jstart3_all(:) )
136         j2 = maxval( jend3_all(:) )
137     
138         i1 = minval( istart3_all(:) )
139         i2 = maxval( iend3_all(:) )
140     
141         ksize = (k2-k1+1)
142         jsize = (j2-j1+1)
143         isize = (i2-i1+1)
144     
145     
146         if (mod(ijk,isize*jsize).ne.0) then
147            k = int( ijk/(isize*jsize) ) + k1
148         else
149            k = int( ijk/(isize*jsize) ) + k1 -1
150         endif
151         ijk = ijk - (k-k1)*(isize*jsize)
152     
153         if (mod(ijk,isize).ne.0) then
154            j = int( ijk/isize ) + j1
155         else
156            j = int( ijk/isize ) + j1 - 1
157         endif
158         ijk = ijk - (j-j1)*isize
159     
160         i = (ijk-1) + i1
161         !       ------------
162         !       double check
163         !       ------------
164         isok_i = (i1 <= i) .and. (i <= i2)
165         isok_j = (j1 <= j) .and. (j <= j2)
166         isok_k = (k1 <= k) .and. (k <= k2)
167         gijk = 1 + (i-i1) + (j-j1)*(i2-i1+1) + &
168              (k-k1)*(j2-j1+1)*(i2-i1+1)
169         is_same = (gijk .eq. ijkp)
170         isok = isok_i .and. isok_j .and. isok_k .and. is_same
171         if (.not.isok) then
172            call write_debug( name, 'i,j,k ', i,j,k )
173            call write_debug( name, 'ijkp, gijk ', ijkp, gijk )
174         endif
175     
176     
177         return
178       end subroutine ijk_of_gl
179     
180       subroutine sendrecv_init(        &
181            comm,                    &
182            cyclic_i,cyclic_j,cyclic_k, idebug )
183         implicit none
184     
185         integer, intent(in) :: comm
186         logical,intent(in) :: cyclic_i,cyclic_j,cyclic_k
187     
188         integer, intent(in), optional :: idebug
189     
190         return
191       end subroutine sendrecv_init
192     
193     
194     
195       subroutine sendrecv_begin_1d( X, ilayer, idebug )
196         implicit none
197     
198         integer, intent(in),optional :: ilayer
199         double precision, intent(inout), dimension(:) :: X
200         integer, intent(in), optional :: idebug
201     
202         return
203       end subroutine sendrecv_begin_1d
204     
205     
206       subroutine sendrecv_begin_1i( X, ilayer, idebug )
207         implicit none
208     
209         integer, intent(in),optional :: ilayer
210         integer, intent(inout), dimension(:) :: X
211         integer, intent(in), optional :: idebug
212     
213         return
214       end subroutine sendrecv_begin_1i
215     
216     
217       subroutine sendrecv_begin_1c( X, ilayer, idebug )
218         implicit none
219     
220         integer, intent(in),optional :: ilayer
221         character(len=*), intent(inout), dimension(:) :: X
222         integer, intent(in), optional :: idebug
223     
224         return
225       end subroutine sendrecv_begin_1c
226     
227     
228       subroutine sendrecv_end_1d( X, idebug )
229         double precision, intent(inout), dimension(:) :: X
230         integer, intent(in), optional :: idebug
231         return
232       end subroutine sendrecv_end_1d
233     
234     
235       subroutine sendrecv_end_1c( X, idebug )
236         character(len=*), intent(inout), dimension(:) :: X
237         integer, intent(in), optional :: idebug
238         return
239       end subroutine sendrecv_end_1c
240     
241     
242       subroutine sendrecv_end_1i( X, idebug )
243         integer, intent(inout), dimension(:) :: X
244         integer, intent(in), optional :: idebug
245         return
246       end subroutine sendrecv_end_1i
247     
248     
249       subroutine send_recv_1c( X, ilayer, idebug )
250         character(len=*),  dimension(:), intent(inout) :: X
251         integer, intent(in), optional :: ilayer,idebug
252         return
253       end subroutine send_recv_1c
254     
255       subroutine send_recv_1d( X, ilayer, idebug )
256         double precision,  dimension(:), intent(inout) :: X
257         integer, intent(in), optional :: ilayer,idebug
258         return
259       end subroutine send_recv_1d
260     
261       subroutine send_recv_2d( X, ilayer, idebug )
262         double precision,  dimension(:,:), intent(inout) :: X
263         integer, intent(in), optional :: ilayer,idebug
264         return
265       end subroutine send_recv_2d
266     
267       subroutine send_recv_3d( X, ilayer, idebug )
268         double precision,  dimension(:,:,:), intent(inout) :: X
269         integer, intent(in), optional :: ilayer,idebug
270         return
271       end subroutine send_recv_3d
272     
273       subroutine send_recv_1i( X, ilayer, idebug )
274         integer,  dimension(:), intent(inout) :: X
275         integer, intent(in), optional :: ilayer,idebug
276         return
277       end subroutine send_recv_1i
278     
279       ! Re-initialize send/receive after re-indexing
280       subroutine sendrecv_re_init_after_re_indexing(comm, idebug )
281         implicit none
282         integer, intent(in) :: comm
283         integer, intent(in), optional :: idebug
284         return
285       end subroutine sendrecv_re_init_after_re_indexing
286     
287     
288     end module sendrecv
289