Clicky
Showing changes from revision #3 to #4:
(追記) Added (追記ここまで) | (削除) Removed (削除ここまで) | (削除) Chan (削除ここまで)(追記) ged (追記ここまで)
** 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\
(削除ここまで)(追記) %s\n", (追記ここまで)(削除) ", (削除ここまで) name.sysname);
fprintf (stderr, "*f_uname* nodename:(削除) %s\
(削除ここまで)(追記) %s\n", (追記ここまで)(削除) ", (削除ここまで) name.nodename);
fprintf (stderr, "*f_uname* release: (削除) %s\
(削除ここまで)(追記) %s\n", (追記ここまで)(削除) ", (削除ここまで) name.release);
fprintf (stderr, "*f_uname* version: (削除) %s\
(削除ここまで)(追記) %s\n", (追記ここまで)(削除) ", (削除ここまで) name.version);
fprintf (stderr, "*f_uname* machine: (削除) %s\
(削除ここまで)(追記) %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\
(削除ここまで)(追記) 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
!-------------------------------------------------------------------
#endifThe 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