NCSA Home
Contact Us | Intranet | Search

Fortran calling C sample code

[arnoldg@honest3 ~/fortran]$ cat fileops.f
c   simple f77 program demonstrating some file operations implemented via
c   wrapper functions written in c
         program main

c   make a directory
         call mkdir('newdir'//CHAR(0) )
c   creat a file
         call creat('newdir/myfile.out'//CHAR(0) )
c   list [scan] a directory
         print *, 'scandir() before unlink:'
         call scandir('newdir'//CHAR(0) )
c   remove [unlink] a file
         call unlink('newdir/myfile.out'//CHAR(0) )
         print *, 'scandir() after unlink:'
         call scandir('newdir'//CHAR(0) )
c   remove a directory
         call rmdir('newdir'//CHAR(0) )
         end
[arnoldg@honest3 ~/fortran]$ cat unixfile.c
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <dirent.h>

/* note trailing underscore for a c function that will be called from fortran
*/
int mkdir_(char *pathname)
{
        int return_status;

        return_status= mkdir(pathname,S_IREAD|S_IEXEC|S_IWRITE);

        if (return_status != 0)
        {
                perror(pathname);
                return(-1);
        }
        return(0);
}

int creat_(char *pathname)
{
        int return_status;

        return_status= creat(pathname,S_IREAD|S_IEXEC|S_IWRITE);

        /* for creat() , the return status will be the file descriptor if
         * successful, so perror() below will print a success message
         */
        if (return_status != 0)
        {
                perror(pathname);
                return(-1);
        }
        return(0);
}

int unlink_(char *pathname)
{
        int return_status;

        return_status= unlink(pathname);

        if (return_status != 0)
        {
                perror(pathname);
                return(-1);
        }
        return(0);
}

int rmdir_(char *pathname)
{
        int return_status;

        return_status= rmdir(pathname);

        if (return_status != 0)
        {
                perror(pathname);
                return(-1);
        }
        return(0);
}

int scandir_(char *pathname)
{

        /* print files in pathname directory in reverse order */
        struct dirent **namelist;
        int n;

        n = scandir(pathname, &namelist, 0, alphasort);
        if (n < 0)
             perror("scandir");
        else {
             while(n--) {
                   printf("%s\n", namelist[n]->d_name);
                   free(namelist[n]);
             }
             free(namelist);
         }

        return(0);
}

[arnoldg@honest3 ~/fortran]$ icc -c -g unixfile.c
[arnoldg@honest3 ~/fortran]$ ifort -g -o fileops fileops.f unixfile.o
[arnoldg@honest3 ~/fortran]$ ./fileops 
newdir/myfile.out: Success
 scandir() before unlink:
myfile.out
..
.
 scandir() after unlink:
..
.
[arnoldg@honest3 ~/fortran]$