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 powertclpower.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:
*/
