fortran code for 'cp' / subroutine file_copy

Hi all,

I would like to issue a copy operation from within my Fortran code. I
have been using the system intrinsic, however, some compilers do not
know about this intrinsic.

While trying to implement my file_copy subroutine, I got stuck at the
open and read statements for an arbitrary (binary or ascii) file to
copy. both gfortran and f90 (nag) give different runtime errors. Any
recommendations, has anyone else implemented this?

TIA, Carsten

subroutine file_copy(arg1,arg2,status,delete)

character(len=*),intent(in) :: arg1,arg2
integer,intent(out) :: status
logical,intent(in) :: delete

integer :: in=20,out=21,error,irec=0
integer,parameter :: rsize=512
character(len=rsize) :: buffer

open(unit=in,file=trim(arg1),status='old',action='read', &
iostat=error,form='unformatted')

if (error.ne.0) then
status=1
write(*,'(3A,I6,A)') 'Cannot read file ',trim(arg1),' (Error code '&
&,error,')'
return
endif

open(unit=out,file=trim(arg2),status='replace',action='write', &
iostat=error,form='unformatted')

if (error.ne.0) then
status=1
write(*,'(A,A,A,I6,A)') 'Cannot write file ',trim(arg2),' (Error
code '&
&,error,')'
return
endif

do
irec=irec+1
print*,irec
read(in,iostat=error) buffer

if (error < 0) exit ! End of data record
if (error > 0) then
status=1
write(*,'(A,A,A,I6,A)') 'Data read error in file ',trim(arg1),'
(Error code '&
&,error,')'
exit
endif

write(out,iostat=error) buffer
if (error > 0) then
status=1
write(*,'(A,A,A,I6,A)') 'Data write error in file ',trim(arg2),'
(Error code '&
&,error,')'
exit
endif
end do

close(unit=out)
if ((status == 0) .and. delete) then
close(unit=in,status='delete')
else
close(unit=in,status='keep')
endif


end subroutine file_copy
.

Relevant Pages