This is the mail archive of the
gsl-discuss@sources.redhat.com
mailing list for the GSL project.
GSL Fortran 77 language binding
- To: gsl-discuss at sourceware dot cygnus dot com
- Subject: GSL Fortran 77 language binding
- From: "E. Robert Tisdale" <edwin at netwood dot net>
- Date: Sun, 16 Jul 2000 22:22:05 +0000
c How about a Fortran 77 language binding for the GSL?
c C preprocessor macros can be used
c to help hide the actual data representation and
c to help access private data members.
c
c $ g77 -o gsl_test gsl_test.F \
c gsl_handle_init__.o gsl_handle_get__.o gsl_handle_put__.o
c
#define gsl_handle integer
#define gsl_offset integer
#define gsl_extent integer
#define gsl_stride integer
#define gsl_vector integer
#ifdef GSL_DEBUG
#define gsl_vector_size 5
#else
#define gsl_vector_size 4
#endif GSL_DEBUG
#define gsl_vector_handle(v) v(1)
#define gsl_vector_offset(v) v(2)
#define gsl_vector_extent(v) v(3)
#define gsl_vector_stride(v) v(4)
#define gsl_single real
#define gsl_double double precision
c
c external functions
c
c gsl_handle function gsl_handle_init(d)
c implicit none
c gsl_double d(1)
c
c gsl_handle function gsl_handle_allo(n)
c implicit none
c gsl_extent n
c
c subroutine gsl_handle_free(h)
c implicit none
c gsl_handle h
c
c gsl_double function gsl_handle_get(h, j)
c implicit none
c gsl_handle h
c gsl_offset j
c
c subroutine gsl_handle_put(h, j, x)
c gsl_handle h
c gsl_offset j
c gsl_double x
c
subroutine gsl_vector_init(v, h, o, n, s)
implicit none
gsl_vector v(gsl_vector_size)
gsl_handle h
gsl_offset o
gsl_extent n
gsl_stride s
v(1) = h
v(2) = o
v(3) = n
v(4) = s
#ifdef GSL_DEBUG
v(5) = 1
#endif GSL_DEBUG
end
c
gsl_double function gsl_vector_get(v, i)
implicit none
gsl_vector v(gsl_vector_size)
gsl_offset i
gsl_double gsl_handle_get
gsl_handle gsl_vector_handle
gsl_offset o
o = gsl_vector_offset(v) + (i-1)*gsl_vector_stride(v)
gsl_vector_get = gsl_handle_get(gsl_vector_handle(v), o)
end
c
subroutine gsl_vector_put(v, i, x)
implicit none
gsl_vector v(gsl_vector_size)
gsl_offset i
gsl_double x
gsl_handle gsl_vector_handle
gsl_offset o
o = gsl_vector_offset(v) + (i-1)*gsl_vector_stride(v)
call gsl_handle_put(gsl_vector_handle(v), o, x)
end
c
program main
implicit none
gsl_offset i
gsl_double x
gsl_double gsl_vector_get
gsl_double d(10)
gsl_vector v(gsl_vector_size)
gsl_handle gsl_handle_init
call gsl_vector_init(v, gsl_handle_init(d), 0, 10, 1)
do i = 1, 10
x = i
call gsl_vector_put(v, i, x)
end do
do i = 1, 10
write(*,*) gsl_vector_get(v, i)
end do
stop
end
c
c /* gsl_handle_init__.c */
c typedef int gsl_handle;
c typedef double gsl_double;
c
c gsl_handle gsl_handle_init__(gsl_double* pd) {
c return (gsl_handle)pd;
c }
c
c /* gsl_handle_allo__.c */
c #include<stdlib.h>
c
c typedef int gsl_handle;
c typedef int gsl_extent;
c typedef double gsl_double;
c
c gsl_handle gsl_handle_allo__(gsl_extent* n) {
c void* p = malloc((size_t)(*n)*sizeof(gsl_double));
c return (gsl_handle)p;
c }
c
c /* gsl_handle_free__.c */
c #include<stdlib.h>
c
c typedef int gsl_handle;
c
c void gsl_handle_free__(gsl_handle* h) {
c free((void*)(*h));
c }
c
c /* gsl_handle_get__.c */
c typedef int gsl_offset;
c typedef double gsl_double;
c
c gsl_double gsl_handle_get__(gsl_double** ppd, gsl_offset *o) {
c return (*ppd)[*o];
c }
c
c /* gsl_handle_put__.c */
c typedef int gsl_offset;
c typedef double gsl_double;
c
c void gsl_handle_put__(gsl_double** ppd, gsl_offset* o, gsl_double* pd) {
c (*ppd)[*o] = *pd;
c }