1
2#define NBLOCKS 4
3
4
5*
6*     ***********************************
7*     *					*
8*     *	        C1dB_SumAll		*
9*     *					*
10*     ***********************************
11
12      subroutine C1dB_SumAll(sum)
13c     implicit none
14      real*8  sum
15
16#include "tcgmsg.fh"
17#include "msgtypesf.h"
18#include "C1dB.fh"
19
20
21*     **** external functions ****
22      integer  Parallel3d_comm_j
23      external Parallel3d_comm_j
24
25
26      if (np_j.gt.1) then
27         call GA_PGROUP_DGOP(Parallel3d_comm_j(),
28     >                       9+MSGDBL,sum,1,'+')
29      end if
30
31      return
32      end
33
34
35*     ***********************************
36*     *					*
37*     *	        C1dB_ISumAll		*
38*     *					*
39*     ***********************************
40
41      subroutine C1dB_ISumAll(sum)
42c     implicit none
43      integer  sum
44
45
46#include "tcgmsg.fh"
47#include "msgtypesf.h"
48#include "C1dB.fh"
49
50
51*     **** external functions ****
52      integer  Parallel3d_comm_j
53      external Parallel3d_comm_j
54
55
56
57      if (np_j.gt.1) then
58        call GA_PGROUP_IGOP(Parallel3d_comm_j(),
59     >                      9+MSGINT,sum,1,'+')
60      end if
61
62      return
63      end
64
65
66
67
68
69*     ***********************************
70*     *                                 *
71*     *         C1dB_MaxAll             *
72*     *                                 *
73*     ***********************************
74      subroutine C1dB_MaxAll(sum)
75c     implicit none
76      real*8  sum
77
78#include "tcgmsg.fh"
79#include "msgtypesf.h"
80#include "C1dB.fh"
81
82      integer msglen,mpierr,np
83      real*8  sumall
84
85*     **** external functions ****
86      integer  Parallel3d_comm_j
87      external Parallel3d_comm_j
88
89      if (np_j.gt.1) then
90         call GA_PGROUP_DGOP(Parallel3d_comm_j(),
91     >                       9+MSGDBL,sum,1,'max')
92      end if
93
94
95      return
96      end
97
98
99
100*     ***********************************
101*     *					*
102*     *	        C1dB_Vector_SumAll	*
103*     *					*
104*     ***********************************
105
106      subroutine C1dB_Vector_SumAll(n,sum)
107c     implicit none
108      integer n
109      real*8  sum(*)
110
111#include "bafdecls.fh"
112
113#include "tcgmsg.fh"
114#include "msgtypesf.h"
115#include "errquit.fh"
116#include "C1dB.fh"
117
118
119
120*     **** external functions ****
121      integer  Parallel3d_comm_j
122      external Parallel3d_comm_j
123
124
125      if (np_j.gt.1) then
126         call GA_PGROUP_DGOP(Parallel3d_comm_j(),
127     >                       9+MSGDBL,sum,n,'+')
128      end if
129      return
130      end
131
132
133*     ***********************************
134*     *					*
135*     *	        C1dB_Vector_ISumAll	*
136*     *					*
137*     ***********************************
138
139      subroutine C1dB_Vector_ISumAll(n,sum)
140c     implicit none
141      integer n
142      integer  sum(*)
143
144#include "bafdecls.fh"
145#include "errquit.fh"
146
147#include "tcgmsg.fh"
148#include "msgtypesf.h"
149#include "C1dB.fh"
150
151
152*     **** external functions ****
153      integer  Parallel3d_comm_j
154      external Parallel3d_comm_j
155
156
157      if (np_j.gt.1) then
158        call GA_PGROUP_IGOP(Parallel3d_comm_j(),
159     >                      9+MSGINT,sum,n,'+')
160      end if
161
162      return
163      end
164
165
166
167*     ***********************************
168*     *                                 *
169*     *      C1dB_Brdcst_values         *
170*     *                                 *
171*     ***********************************
172
173      subroutine C1dB_Brdcst_values(psend,nsize,sum)
174      implicit none
175      integer psend,nsize
176      real*8  sum(*)
177
178#include "bafdecls.fh"
179#include "errquit.fh"
180#include "tcgmsg.fh"
181#include "msgtypesf.h"
182#include "C1dB.fh"
183
184*     **** external functions ****
185      integer  Parallel3d_comm_j
186      external Parallel3d_comm_j
187
188      integer np
189
190      call Parallel3d_np_j(np)
191      if (np.gt.1) then
192         call GA_PGROUP_BRDCST(Parallel3d_comm_j(),
193     >                         9+MSGDBL,sum,mdtob(nsize),psend)
194      end if
195
196      return
197      end
198
199
200
201*     ***********************************
202*     *                                 *
203*     *         C1dB_isendrecv          *
204*     *                                 *
205*     ***********************************
206      subroutine C1dB_isendrecv(pto,  ssize,sdata,
207     >                          pfrom,rsize,rdata,
208     >                          request,reqcnt)
209      implicit none
210      integer pto,ssize
211      real*8  sdata(*)
212      integer pfrom,rsize
213      real*8  rdata(*)
214      integer request(*)
215      integer reqcnt
216
217#include "C1dB.fh"
218
219
220*     **** local variables ****
221      integer msgtype,mpierr
222
223*     **** external functions ****
224      integer  Parallel3d_comm_j
225      external Parallel3d_comm_j
226
227
228      call errquit(' C1dB_isendrecv:not implemented!',0,0)
229      return
230      end
231
232*     ***********************************
233*     *                                 *
234*     *         C1dB_WaitAll            *
235*     *                                 *
236*     ***********************************
237*
238*  This routine waits for the sends and receives to
239* finish that were started with C1dB_isendrecv
240*
241      subroutine C1dB_WaitAll(request,reqcnt)
242      implicit none
243      integer request(*)
244      integer reqcnt
245
246#include "bafdecls.fh"
247#include "errquit.fh"
248
249      call errquit(' C1dB_WaitAll:not implemented!',0,0)
250      return
251      end
252
253c     ****************************************
254c     *                                      *
255c     *          C1dB_Brdcst_step            *
256c     *                                      *
257c     ****************************************
258c
259c  This routine performs step l of a butterfly Broadcast all algorithm. The step
260c  l spans from 0..(Level-1) where the number of levels is Level = Log(np_j)/Log(2).
261c
262c   Entry - l: Butterfly step 0...(Level-1)
263c           na: an array of length np_j containing the number of orbitals per taskid_j
264c           blocks0: number of blocks to send size=blocks0,
265c                    the exceptions are:
266c                    if blocks0==0: the block size is size=2**l.
267c                    if blocks0==-1: block size is size=(np_j-2**Level)/2 + 1 for l==(Level-1),
268c                                    blocksize is size=2**l otherwise
269c           n2ft3d: leading size of psi_rep
270c           psi_rep: data array
271c   Exit -
272c           psi_rep: modified data array
273c           requests,reqcnt: tags for asychronous message passing
274c
275      subroutine C1dB_Brdcst_step(l,na,blocks0,
276     >                            n2ft3d,psi_rep,
277     >                            requests,reqcnt)
278      implicit none
279      integer l,na(*),blocks0
280      integer n2ft3d
281      real*8 psi_rep(n2ft3d,*)
282      integer requests(*),reqcnt
283
284*     *** local variables ***
285      integer taskid_j,np_j
286      integer i,pr,ps,shift,size,Level
287      integer pto,pfrom,rsize,ssize,rindx,sindx
288
289*     *** local variables ***
290      integer  Butter_levels
291      external Butter_levels
292
293      call errquit(' C1dB_Brdcst_step:not implemented!',0,0)
294      return
295      end
296
297
298c     ****************************************
299c     *                                      *
300c     *           C1dB_Reduce_step           *
301c     *                                      *
302c     ****************************************
303c
304c  This routine performs step l of a butterfly Reduceall algorithm. The step
305c  l spans from 0..(Level-1) where the number of levels is Level = Log(np_j)/Log(2).
306c
307c   Entry - l: Butterfly step 0...(Level-1)
308c           na: an array of length np_j containing the number of orbitals per taskid_j
309c           blocks0: number of blocks to send size=blocks0,
310c                    the exceptions are:
311c                    if blocks0==0: the block size is size=2**l.
312c                    if blocks0==-1: block size is size=(np_j-2**Level)/2 + 1 for l==(Level-1),
313c                                    blocksize is size=2**l otherwise
314c           n2ft3d: leading size of psi_rep
315c           hpsi_rep: data array
316c           tmp: tempory data array. Needs to be at least  n2ft3d*size
317c
318c   Exit - hpsi_rep: modified data array
319c          requests,reqcnt: tags for asychronous message passing
320c
321      subroutine C1dB_Reduce_step(l,na,blocks0,
322     >                            n2ft3d,hpsi_rep,tmp)
323      implicit none
324      integer l,na(*),blocks0
325      integer n2ft3d
326      real*8 hpsi_rep(n2ft3d,*)
327      real*8 tmp(*)
328
329*     *** local variables ***
330      integer taskid_j,np_j
331      integer i,pr,ps,size,shift,Level,pfrom,pto
332      integer rsize,ssize,rindx,sindx
333      integer requests(10),reqcnt
334
335*     *** local variables ***
336      integer  Butter_levels
337      external Butter_levels
338
339      call errquit(' C1dB_Reduce_step:not implemented!',0,0)
340      return
341      end
342c $Id$
343