34
35
36
37
38 USE spmd_comm_world_mod, ONLY : spmd_comm_world
39#include "implicit_f.inc"
40
41
42
43#include "spmd.inc"
44
45
46
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "task_c.inc"
50
51
52
53 INTEGER ICSIZE, IAD_RBY(*),FR_RBY6(*)
54 double precision
55 . rbf6(6,6,nrbym)
56
57
58
59#ifdef MPI
60 INTEGER MSGTYP,LOC_PROC,A_AR,NOD,L,I,J,IAD,IRB,
61 . MSGOFF,SIZ,IDEB, LEN,INDEX,NBINDEX,
62 . (NSPMD),REQ_R(NSPMD),REQ_S(NSPMD)
63 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
64 DATA msgoff/167/
65 parameter(a_ar = 36)
66 double precision
67 . rbuf(icsize*a_ar), sbuf(icsize*a_ar)
68
69
70
71 loc_proc = ispmd + 1
72 ideb = 1
73 l = 0
74 DO i = 1, nspmd
75 len = iad_rby(i+1)-iad_rby(i)
76 IF(len>0) THEN
77 siz = len*a_ar
78 l=l+1
79 indexi(l)=i
80 msgtyp = msgoff
82 s rbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
83 g spmd_comm_world,req_r(l),ierror)
84 ideb = ideb + siz
85 ENDIF
86 ENDDO
87 nbindex = l
88
89 ideb = 1
90 DO l = 1, nbindex
91 i = indexi(l)
92 len = iad_rby(i+1)-iad_rby(i)
93 iad = iad_rby(i)-1
94#include "vectorize.inc"
95 DO j = 1, len
96 irb = fr_rby6(iad+j)
97 sbuf(ideb) = rbf6(1,1,irb)
98 sbuf(ideb+1) = rbf6(1,2,irb)
99 sbuf(ideb+2) = rbf6(1,3,irb)
100 sbuf(ideb+3) = rbf6(1,4,irb)
101 sbuf(ideb+4) = rbf6(1,5,irb)
102 sbuf(ideb+5) = rbf6(1,6,irb)
103 sbuf(ideb+6) = rbf6(2,1,irb)
104 sbuf(ideb+7) = rbf6(2,2,irb)
105 sbuf(ideb+8) = rbf6(2,3,irb)
106 sbuf(ideb+9) = rbf6(2,4,irb)
107 sbuf(ideb+10)= rbf6(2,5,irb)
108 sbuf(ideb+11)= rbf6(2,6,irb)
109 sbuf(ideb+12)= rbf6(3,1,irb)
110 sbuf(ideb+13)= rbf6(3,2,irb)
111 sbuf(ideb+14)= rbf6(3,3,irb)
112 sbuf(ideb+15)= rbf6(3,4,irb)
113 sbuf(ideb+16)= rbf6(3,5,irb)
114 sbuf(ideb+17)= rbf6(3,6,irb)
115 sbuf(ideb+18)= rbf6(4,1,irb)
116 sbuf(ideb+19)= rbf6(4,2,irb)
117 sbuf(ideb+20)= rbf6(4,3,irb)
118 sbuf(ideb+21)= rbf6(4,4,irb)
119 sbuf(ideb+22)= rbf6(4,5,irb)
120 sbuf(ideb+23)= rbf6(4,6,irb)
121 sbuf(ideb+24)= rbf6(5,1,irb)
122 sbuf(ideb+25)= rbf6(5,2,irb)
123 sbuf(ideb+26)= rbf6(5,3,irb)
124 sbuf(ideb+27)= rbf6(5,4,irb)
125 sbuf(ideb+28)= rbf6(5,5,irb)
126 sbuf(ideb+29)= rbf6(5,6,irb)
127 sbuf(ideb+30)= rbf6(6,1,irb)
128 sbuf(ideb+31)= rbf6(6,2,irb)
129 sbuf(ideb+32)= rbf6(6,3,irb)
130 sbuf(ideb+33)= rbf6(6,4,irb)
131 sbuf(ideb+34)= rbf6(6,5,irb)
132 sbuf(ideb+35)= rbf6(6,6,irb)
133 ideb = ideb + a_ar
134 ENDDO
135 ENDDO
136
137 ideb = 1
138 DO l=1,nbindex
139 i = indexi(l)
140 len = iad_rby(i+1)-iad_rby(i)
141 siz = len*a_ar
142 msgtyp = msgoff
144 s sbuf(ideb),siz,mpi_double_precision,it_spmd(i),msgtyp,
145 g spmd_comm_world,req_s(l),ierror)
146 ideb = ideb + siz
147 ENDDO
148
149 DO l=1,nbindex
150 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
151 i = indexi(index)
152 ideb = 1+(iad_rby(i)-1)*a_ar
153 len = iad_rby(i+1)-iad_rby(i)
154 iad = iad_rby(i)-1
155#include "vectorize.inc"
156 DO j = 1, len
157 irb = fr_rby6(iad+j)
158 rbf6(1,1,irb)= rbf6(1,1,irb) + rbuf(ideb)
159 rbf6(1,2,irb)= rbf6(1,2,irb) + rbuf(ideb+1)
160 rbf6(1,3,irb)= rbf6(1,3,irb) + rbuf(ideb+2)
161 rbf6(1,4,irb)= rbf6(1,4,irb) + rbuf(ideb+3)
162 rbf6(1,5,irb)= rbf6(1,5,irb) + rbuf(ideb+4)
163 rbf6(1,6,irb)= rbf6(1,6,irb) + rbuf(ideb+5)
164 rbf6(2,1,irb)= rbf6(2,1,irb) + rbuf(ideb+6)
165 rbf6(2,2,irb)= rbf6(2,2,irb) + rbuf(ideb+7)
166 rbf6(2,3,irb)= rbf6(2,3,irb) + rbuf(ideb+8)
167 rbf6(2,4,irb)= rbf6(2,4,irb) + rbuf(ideb+9)
168 rbf6(2,5,irb)= rbf6(2,5,irb) + rbuf(ideb+10)
169 rbf6(2,6,irb)= rbf6(2,6,irb) + rbuf(ideb+11)
170 rbf6(3,1,irb)= rbf6(3,1,irb) + rbuf(ideb+12)
171 rbf6(3,2,irb)= rbf6(3,2,irb) + rbuf(ideb+13)
172 rbf6(3,3,irb)= rbf6(3,3,irb) + rbuf(ideb+14)
173 rbf6(3,4,irb)= rbf6(3,4,irb) + rbuf(ideb+15)
174 rbf6(3,5,irb)= rbf6(3,5,irb) + rbuf(ideb+16)
175 rbf6(3,6,irb)= rbf6(3,6,irb) + rbuf(ideb+17)
176 rbf6(4,1,irb)= rbf6(4,1,irb) + rbuf(ideb+18)
177 rbf6(4,2,irb)= rbf6(4,2,irb) + rbuf(ideb+19)
178 rbf6(4,3,irb)= rbf6(4,3,irb) + rbuf(ideb+20)
179 rbf6(4,4,irb)= rbf6(4,4,irb) + rbuf(ideb+21)
180 rbf6(4,5,irb)= rbf6(4,5,irb) + rbuf(ideb+22)
181 rbf6(4,6,irb)= rbf6(4,6,irb) + rbuf(ideb+23)
182 rbf6(5,1,irb)= rbf6(5,1,irb) + rbuf(ideb+24)
183 rbf6(5,2,irb)= rbf6(5,2,irb) + rbuf(ideb+25)
184 rbf6(5,3,irb)= rbf6(5,3,irb) + rbuf(ideb+26)
185 rbf6(5,4,irb)= rbf6(5,4,irb) + rbuf(ideb+27)
186 rbf6(5,5,irb)= rbf6(5,5,irb) + rbuf(ideb+28)
187 rbf6(5,6,irb)= rbf6(5,6,irb) + rbuf(ideb+29)
188 rbf6(6,1,irb)= rbf6(6,1,irb) + rbuf(ideb+30)
189 rbf6(6,2,irb)= rbf6(6,2,irb) + rbuf(ideb+31)
190 rbf6(6,3,irb)= rbf6(6,3,irb) + rbuf(ideb+32)
191 rbf6(6,4,irb)= rbf6(6,4,irb) + rbuf(ideb+33)
192 rbf6(6,5,irb)= rbf6(6,5,irb) + rbuf(ideb+34)
193 rbf6(6,6,irb)= rbf6(6,6,irb) + rbuf(ideb+35)
194 ideb = ideb + a_ar
195 ENDDO
196 ENDDO
197
198 DO l=1,nbindex
199 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
200 ENDDO
201
202#endif
203 RETURN
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)