Added a small C function to do a binary copy of a file and an interface to call it from fortran

res = f_copy(source, dest)

returns:
 0 : no error
-1 : cannot open source
-2 : cannot open dest
-3 : error while writing
-4 : disk full while writing




git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@10111 c92efa57-630b-4861-b058-cf58834340f0

Modules/wrappers.f90

@@ -27,7 +27,7 @@ MODULE wrappers
   ! C std library functions fortran wrappers:
   PUBLIC  f_remove, f_link, rename, f_chdir, f_mkdir, f_rmdir, f_getcwd
   ! more stuff:
-  PUBLIC  feval_infix, md5_from_file, f_mkdir_safe
+  PUBLIC  f_copy, feval_infix, md5_from_file, f_mkdir_safe
   !
   ! HELP:
   ! integer f_remove(pathname)
@@ -163,8 +163,28 @@ CONTAINS
     ENDDO
     output(i:)=' '
   END SUBROUTINE
-  !
   ! ==================================================================== 
+  ! copy a file, uses clibs/copy.c which currently does a binary copy
+  ! using an 8kb buffer
+  ! 
+  ! returns:
+  !  0 : no error
+  ! -1 : cannot open source
+  ! -2 : cannot open dest
+  ! -3 : error while writing
+  ! -4 : disk full while writing
+  FUNCTION f_copy(source, dest) RESULT(r)
+    INTERFACE
+    FUNCTION c_copy(source,dest) BIND(C,name="copy") RESULT(r)
+      USE iso_c_binding
+      CHARACTER(kind=c_char),INTENT(in)  :: source(*), dest(*)
+      INTEGER(c_int)         :: r
+    END FUNCTION c_copy
+    END INTERFACE
+    CHARACTER(*),INTENT(in)  :: source, dest
+    INTEGER(c_int) :: r
+    r= c_copy(TRIM(source)//C_NULL_CHAR, TRIM(dest)//C_NULL_CHAR)
+  END FUNCTION
   !
   ! safe mkdir from clib/c_mkdir.c that creates a directory, if necessary, 
   ! and checks permissions. It can be called in parallel.

clib/Makefile

@@ -6,6 +6,7 @@ OBJS = \
 customize_signals.o \
 stack.o \
 c_mkdir.o \
+copy.o \
 cptimer.o \
 eval_infix.o \
 fft_stick.o \

clib/copy.c

@@ -0,0 +1,33 @@
+
+
+#include <stdio.h>
+#include <stdlib.h>
+
+int copy(const char* fn_in, const char* fn_out) {
+   
+   FILE *fd1 = fopen(fn_in, "r");
+   if(!fd1) return -1; // cannot open input
+     
+   FILE *fd2 = fopen(fn_out, "w");
+   if(!fd2) {  // cannot open output
+     fclose(fd1);
+     return -2;
+   }
+
+   size_t l1;
+   unsigned char buffer[8192]; 
+
+   while((l1 = fread(buffer, 1, sizeof buffer, fd1)) > 0) {
+     size_t l2 = fwrite(buffer, 1, l1, fd2);
+     if(l2 < 0 || l2 < l1) {
+       fclose(fd1);
+       fclose(fd2);
+       if(l2<0) return -3; // output error
+       return -4; // disk full
+     }
+   }
+   fclose(fd1);
+   fclose(fd2);
+   return 0;
+}
+