Again - Mixed language programming Tcl/Tk and Fortran (Windows)
From: Gustav Ivanovic (gustav_ivanovic_at_yahoo.com)
Date: 12/22/04
- Next message: beliavsky_at_aol.com: "g95 executables on Windows require cygwin1.dll on PATH"
- Previous message: Steve Lionel: "Re: IFC website problem - request for Steve Lionel"
- Next in thread: Arjen Markus: "Re: Again - Mixed language programming Tcl/Tk and Fortran (Windows)"
- Reply: Arjen Markus: "Re: Again - Mixed language programming Tcl/Tk and Fortran (Windows)"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Date: 22 Dec 2004 13:07:27 -0800
Two parts:
1. Tcl code
2. Fortran code. Compile this with CFV to make a dll.
in the example it is called FtnTcl.dll
Be careful with truncated lines.
Have fun !
PART 1 Tcl
######################################################
namespace eval Fortran {
#################################################
# Provides simplified call to CV Fortran DLL for strings and
arrays
# Works with Compaq Visual Fortran 6.1A
# See also "Programming with Mixed Languages" chapter in CVF
Reference Manual
# ffidl can be found here http://www.elf.org/ffidl/
#################################################
proc DirectCall {DLLname routineName varType var} {
# varType is a, i, f or d
# a means CHARACTER(LEN=*) in Compaq Visual Fortran
# f means REAL, DIMENSION(*) in Compaq Visual Fortran
# d means DOUBLE PRECISION, DIMENSION(*) in Compaq Visual
Fortran
# i means INTEGER, DIMENSION(*) in Compaq Visual Fortran,
#
# array size shall be defined as argument in fortran
# see fortran source code
#
upvar $var x
if {$varType == "a"} {
eval [subst {ffidl::callout TclCallName {pointer-var int}
void [ffidl::symbol $DLLname $routineName]}]
set x [binary format a* $x]
TclCallName x [string length $x]
binary scan $x a* x
} else {
eval [subst {ffidl::callout TclCallName {pointer-var} void
[ffidl::symbol $DLLname $routineName]}]
set formatString $varType[llength $x]
set x [binary format $formatString $x]
TclCallName x
binary scan $x $formatString x
}
};#End proc DirectCall
proc DefineCallout {DLLname routineName argDef returnDef} {
# The callout will be inside Fortran namespace ( e.g
Fortran::scalarproduct )
eval [subst {ffidl::callout ::Fortran::$routineName {$argDef}
$returnDef [ffidl::symbol $DLLname $routineName]}]
};#End proc DefineCallout
proc binarize {varType args} {
foreach var $args {
upvar $var x
if {$varType == "a"} {
set x [binary format a* $x]
} else {
set x [binary format $varType[llength $x] $x]
}
}
};#End proc binarize
proc de-binarize {varType args} {
foreach var $args {
upvar $var x
switch $varType {
i {binary scan $x i[expr {[string length $x]/4}] x}
f {binary scan $x f[expr {[string length $x]/4}] x}
d {binary scan $x d[expr {[string length $x]/8}] x}
default {binary scan a* $x x}
}
}
};#End proc de-binarize
};#End namespace Fortran
proc runTest {} {
# Example starts here
load ffidl05.dll
# Call routines using Fortran::DirectCall
# Example with strings
puts "Test 1"
set line ABCDE***
puts $line
Fortran::DirectCall FtnTcl.dll string a line
puts $line
# Example with integers
puts "Test 2"
set x {1 2 3 4}
puts $x
Fortran::DirectCall FtnTcl.dll integervector i x
puts $x
# Example with floating points
puts "Test 3"
set x {1 2 3 4}
puts $x
Fortran::DirectCall FtnTcl.dll realvector f x
puts $x
# Example with double precisions
puts "Test 4"
set x {1 2 3 4}
puts $x
Fortran::DirectCall FtnTcl.dll doublevector d x
puts $x
# Define Callout using Fortran::DefineCallout and then call the
routine
puts "Test 5"
Fortran::DefineCallout FtnTcl.dll scalarproduct {pointer-var
pointer-var pointer-var} float
set l 4
set x {1 1 1 1}
set y {2 2 2 2}
Fortran::binarize i l
Fortran::binarize f x y
puts [Fortran::scalarproduct x y l]
puts "Test 6"
set x {1 2 3 4}
set y {0 0 0 0}
Fortran::binarize f x y
puts [Fortran::scalarproduct x y l]
# More examples
# define the callout using ffidl
puts "More examples"
ffidl::callout scalarProduct {pointer-var pointer-var pointer-var}
float [ffidl::symbol FtnTcl.dll scalarproduct]
ffidl::callout doubleVectorSum {pointer-var pointer-var
pointer-var pointer-var} float [ffidl::symbol FtnTcl.dll
doublevectorsum]
set x {1 2 3 4}
set y {1 2 3 4}
set l 4
Fortran::binarize f x y
Fortran::binarize i l
puts [scalarProduct x y l]
set y {10 10 10 10}
Fortran::binarize f y
puts [scalarProduct x y l]
set x {1 2 3 4}
set y {10 10 10 10}
set z $x
Fortran::binarize d x y z
doubleVectorSum x y z l
Fortran::de-binarize d x y z
puts $x
puts $y
puts $z
};#Endproc runTest
###########
#EXECUTE IT
###########
runTest
######################################################
PART 2 Fortran
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE tcl
CONTAINS
SUBROUTINE doublevector(vector)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'doublevector' ::doublevector
DOUBLE PRECISION , DIMENSION(*) :: vector
vector(3)=3333.
END SUBROUTINE doublevector
SUBROUTINE realvector(vector)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'realvector' ::realvector
REAL , DIMENSION(*) :: vector
vector(2)=2222.
END SUBROUTINE realvector
SUBROUTINE integervector(vector)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'integervector' ::integervector
INTEGER , DIMENSION(*) :: vector
vector(1)=1111
END SUBROUTINE integervector
SUBROUTINE string(line)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'string'::string
CHARACTER(LEN=*) :: line
line='QWERTY'
END SUBROUTINE string
FUNCTION scalarproduct(x,y,n) RESULT (z)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'scalarproduct'::scalarproduct
INTEGER ::n
REAL, DIMENSION(n) :: x, y
REAL :: z
z=sum(x*y)
END FUNCTION scalarproduct
SUBROUTINE doublevectorsum(x,y,z,n)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS:
'doublevectorsum'::doublevectorsum
INTEGER ::n
DOUBLE PRECISION, DIMENSION(n) :: x, y, z
z=x+y
END SUBROUTINE doublevectorsum
END MODULE tcl
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- Next message: beliavsky_at_aol.com: "g95 executables on Windows require cygwin1.dll on PATH"
- Previous message: Steve Lionel: "Re: IFC website problem - request for Steve Lionel"
- Next in thread: Arjen Markus: "Re: Again - Mixed language programming Tcl/Tk and Fortran (Windows)"
- Reply: Arjen Markus: "Re: Again - Mixed language programming Tcl/Tk and Fortran (Windows)"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Relevant Pages
|
