This is the mail archive of the gsl-discuss@sources.redhat.com mailing list for the GSL project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

GSL Fortran 77 language binding


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         }



Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]