1      subroutine copyfile(d_1,d_2,size)
2c
3c $Id$
4c
5c     Duplicate a file
6c
7      implicit none
8#include "global.fh"
9#include "mafdecls.fh"
10#include "stdio.fh"
11#include "util.fh"
12#include "sf.fh"
13#include "errquit.fh"
14#include "tce.fh"
15#include "tce_main.fh"
16      integer d_1
17      integer d_2
18      integer size
19      integer nblocks,blocksize
20      integer l_temp,k_temp
21      integer i
22      logical nodezero
23      logical d_1isga
24      logical d_2isga
25      integer  next, nprocs, count
26      INTEGER NXTASK
27      EXTERNAL NXTASK
28      logical noloadbalance
29c
30c     new
31c
32      if ( fileisga(d_1).and.fileisga(d_2) ) then
33        call ga_copy(d_1,d_2)
34        return
35      endif
36c
37      if ((ioalg.eq.6).and.(fileisga(d_1).neqv.fileisga(d_2)))
38     1  call errquit('unable to copy GA to/from EAF',0,UNKNOWN_ERR)
39      noloadbalance = ((ioalg.eq.4).or.
40     1                ((ioalg.eq.6).and.(.not.fileisga(d_1))))
41      d_1isga = fileisga(d_1)
42      d_2isga = fileisga(d_2)
43      if (.not.d_1isga) call dratoga(d_1)
44      if (.not.d_2isga) call dratoga(d_2)
45      nodezero = (ga_nodeid().eq.0)
46      nblocks = size/buffer_size
47      if (nblocks*buffer_size.lt.size) nblocks = nblocks + 1
48      blocksize = size/nblocks
49      if (nblocks*blocksize.lt.size) blocksize = blocksize + 1
50      if (nodezero.and.util_print('copyfile',print_debug)) then
51        write(LuOut,9190) d_1,size
52        write(LuOut,9190) d_2,size
53        write(LuOut,9200) nblocks,blocksize
54      endif
55      if (.not.ma_push_get(mt_dbl,blocksize,'temporary',
56     1  l_temp,k_temp))
57     2  call errquit('copyfile: MA problem',0,MA_ERR)
58      nprocs = GA_NNODES()
59      count = 0
60cc      next = nxtask(nprocs,1)
61      next = NXTASK(nprocs, 1)
62      do i = 1,nblocks
63        if (noloadbalance.or.(next.eq.count)) then
64          if (util_print('copyfile',print_debug))
65     1      write(LuOut,9210) ga_nodeid(),(i-1)*blocksize,
66     2                        min(size,i*blocksize)-(i-1)*blocksize
67          call get_block(d_1,dbl_mb(k_temp),
68     1      min(size,i*blocksize)-(i-1)*blocksize,(i-1)*blocksize)
69          call put_block(d_2,dbl_mb(k_temp),
70     1      min(size,i*blocksize)-(i-1)*blocksize,(i-1)*blocksize)
71cc          next = nxtask(nprocs,1)
72      next = NXTASK(nprocs, 1)
73        endif
74        count = count + 1
75      enddo
76cc      next = nxtask(-nprocs,1)
77      next = NXTASK(-nprocs, 1)
78      if (.not.ma_pop_stack(l_temp))
79     1  call errquit('copyfile: MA problem',1,MA_ERR)
80      call ga_sync()
81      if (.not.d_1isga) call gatodra(d_1)
82      if (.not.d_2isga) call gatodra(d_2)
83 9190 format(/,1x,'        file handle:',i10,' size:',i10)
84 9200 format(  1x,'            nblocks:',i10,' size:',i10)
85 9210 format(  1x,i3,'          offset:',i10,' size:',i10)
86      return
87      end
88