Clicky

Fortran Wiki
f_uname

** A simple combination of a C routine and a Fortran module bound via the ISO_C_BINDING module that allows you to call uname(3C) from Fortran. **

I have seen several forums where how to query the system type at runtime from Fortran has come up where the offered solutions often involve creating a subprocess and calling uname(1) and either returning the output via a scratch file or a pipe instead of calling the uname(3C) routine directly, which is my preference. Calling the C routine directly using the following method has worked for me with several different compiler/OS programming environments (and several initial attempts did not). This model works with many C routines that I just want to return a simple string to Fortran with.

Feel free to alter this example. I think we could all benefit from a collection of ISO_C_BINDING examples. I know I could.


/* -------------------------------------------------------------------------- */
/* f_uname -- return system information from uname(3c) to Fortran subroutine
*/
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/utsname.h>
/* -------------------------------------------------------------------------- */
void f_uname (char *which, char *string, int *stringlen) {
/* f_uname(3c) returns one element of the structure returned by 
  uname(3c) as a string suitable for return to Fortran. 
*/
   struct utsname name;
   int i;
   int j;
   if (uname (&name) == -1) {
      fprintf (stderr, "*f_uname* cannot get system name\
");
      strncpy (string, "UNKNOWN", *stringlen);
   } else {
      switch (*which) {
      case 's': strncpy (string, name.sysname, *stringlen);
	 break;
      case 'n': strncpy (string, name.nodename, *stringlen);
	 break;
      case 'r': strncpy (string, name.release, *stringlen);
	 break;
      case 'v': strncpy (string, name.version, *stringlen);
	 break;
      case 'm': strncpy (string, name.machine, *stringlen);
	 break;
      case 'T': /* for testing */
	 fprintf (stderr, "*f_uname* sysname:  %s\n", name.sysname);
	 fprintf (stderr, "*f_uname* nodename: %s\n", name.nodename);
	 fprintf (stderr, "*f_uname* release:  %s\n", name.release);
	 fprintf (stderr, "*f_uname* version:  %s\n", name.version);
	 fprintf (stderr, "*f_uname* machine:  %s\n", name.machine);
	 strncpy (string, "", *stringlen);
	 break;
      default:
	 fprintf (stderr, "*f_uname* E-R-R-O-R: unknown switch %c \n",
		  *which);
	 fprintf (stderr, "*f_uname* f_uname:%s:%c:%d\n", string, *which,
		  *stringlen);
	 strncpy (string, "UNKNOWN", *stringlen);
      }
   }
   /* 
      remove null string terminator and fill string with blanks for Fortran 
      */
   for (j = strlen (string); j < *stringlen; j++) {
      string[j] = ' ';
   }
}
#ifdef TESTPRGC
#include <stdio.h>
#include <stdlib.h>
main(){
   char string[20];
   int ii;
   ii=20;
   f_uname("m",string,&ii);
   fprintf (stderr, "C TEST PROGRAM:f_uname:AFTER:%s\
", string);
   exit(0);
}
#endif

`

module m_os
!-------------------------------------------------------------------
! describe the C routine to Fortran
! void f_uname(char *which, char *buf, int *buflen);
  public ::  f_uname_F
   interface
      subroutine f_uname_F(WHICH,BUF,BUFLEN) bind(C,NAME='f_uname')
         use ISO_C_BINDING
         implicit none
         character(KIND=C_CHAR),intent(out) :: BUF(*)
         character(KIND=C_CHAR),intent(in)  :: WHICH
         integer,intent(in)  :: BUFLEN
      end subroutine f_uname_F
   end interface
!-------------------------------------------------------------------
contains
!-------------------------------------------------------------------
subroutine f_uname(WHICH,NAME)
   use ISO_C_BINDING
   implicit none
   character(KIND=C_CHAR),intent(in)   :: WHICH
   character(len=*)                    :: NAME
   NAME='unknown'
   call f_uname_F(WHICH,NAME,LEN(NAME))
end subroutine f_uname
!-------------------------------------------------------------------
end module m_os
!-------------------------------------------------------------------
#ifdef TESTPRG90
program testit
   use m_os
   implicit none
   integer,parameter   :: is=100
   integer             :: i
   character(len=:),parameter :: letters='srvnmxT'
   character(len=is)   :: string=' '
   do i=1,len(letters)
      write(*,'(80("="))')
      call f_uname(letters(i:i),string)
      write(*,*)'=====> TESTING f_uname('//letters(i:i)//')--->'//trim(string)
   enddo

end program testit
!-------------------------------------------------------------------
#endif

The compiler switches vary depending on the Programming Environment, but in mine (where f90(1) is a script that takes such differences into account) the routine can be tested using

   cc -c f_uname.c     
   f90 -DTESTPRG90 m_os.F90 f_uname.o -o _testit
   `./_testit                 # execute test Fortran program

category: code