g77 -c power.f gcc -I/opt/tcl/include -DBUILD_power -DUSE_TCL_STUBS -c tclpower.c gcc -shared tclpower.o power.o /opt/tcl/lib/tclstub84.lib -o power01.dll(fix the extensions for your system. Extending the TEA build system is simple enough, but I don't want to clutter the page here.)Now you can use the library:
% load power01.dll Power % power 5.5 11803.0648209
AM I am working on a Fortran version for Critcl - the pieces are coming together! With this package, extending Tcl with Fortran will become much easier - see Critcl goes FortranAM (9 november 2007) What about extending a Fortran program, say, with a Fortran-like scripting language? See: Almost Fortran
power.f
c power.f - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sf.net> c c Demonstrate linking Fortran subroutines into Tcl packages. c c $Id: 8507,v 1.5 2007-03-10 07:00:14 jcw Exp $ c double precision function power(x) double precision x power = x ** x end function power
tclpower.c
/* tclpower.c - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sf.net> * * Demonstrate creation of a Tcl module that interfaces to Fortran * subroutines. * * This package relies upon g77's ability to create objects that can be * easily linked into C generated modules. * * $Id: 8507,v 1.5 2007-03-10 07:00:14 jcw Exp $ */ #include <tcl.h> #ifdef BUILD_power #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT #endif #define PACKAGE "Power" #ifndef VERSION #define VERSION "0.1" #endif EXTERN int Power_Init(Tcl_Interp *interp); EXTERN int Power_SafeInit(Tcl_Interp *interp); /* * Declare the fortran functions - to be linked in to this executable. */ double power_(CONST double *d); /* * Tcl command procedures */ static Power_ObjCmd(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); /* ---------------------------------------------------------------------- */ int Power_Init(Tcl_Interp* interp) { #ifdef USE_TCL_STUBS Tcl_InitStubs(interp, "8.1", 0); #endif // Call Tcl_CreateObjCommand etc. Tcl_CreateObjCommand(interp, "power", Power_ObjCmd, (ClientData *)NULL, (Tcl_CmdDeleteProc *)NULL); return Tcl_PkgProvide(interp, PACKAGE, VERSION); } int Test2_SafeInit(Tcl_Interp* interp) { // We don't need to be specially safe so... return Power_Init(interp); } /* ---------------------------------------------------------------------- */ static int Power_ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { double d, dr; int r = TCL_OK; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "real value"); r = TCL_ERROR; } if (r == TCL_OK) r = Tcl_GetDoubleFromObj(interp, objv[1], &d); if (r == TCL_OK) { dr = power_(&d); Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dr)); } return r; } /* ---------------------------------------------------------------------- */ /* * Local variables: * mode: c * indent-tabs-mode: nil * End: */