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