OpenXM/src/ox_gsl/ox_gsl.c - diff

Return to ox_gsl.c CVS log

Up to [local] / OpenXM / src / ox_gsl

Diff for /OpenXM/src/ox_gsl/ox_gsl.c between version 1.13 and 1.17

-version 1.13, 2018/06/07 11:13:05
+version 1.17, 2019/10/23 07:00:43
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.12 2018/06/07 01:53:33 takayama Exp $
+ /* $OpenXM: OpenXM/src/ox_gsl/ox_gsl.c,v 1.16 2019/10/21 05:37:20 takayama Exp $
  */
  #include <stdio.h>
 Line 10
 Line 10
 Line 10
  #include <math.h>
  #include "ox_gsl.h"
  #include "call_gsl.h" // need only when you bind call_gsl functions.
+ #include "call_gsl_sf.h"
  OXFILE *fd_rw;
-Line 223  double get_double()
+Line 224  double get_double()
 Line 223  double get_double()
 Line 224  double get_double()
      myhandler("get_double: not a double",NULL,0,-1);
      return(NAN);
  }
+ /* get_double() will be obsolted and will be replaced by cmo2double(c) */
+ double cmo2double(cmo *c)
+ {
+ #define mympz(c) (((cmo_zz *)c)->mpz)
+   if (c == NULL) c = pop();
+     if (c->tag == CMO_INT32) {
+         return( (double) (((cmo_int32 *)c)->i) );
+     }else if (c->tag == CMO_IEEE_DOUBLE_FLOAT) {
+         return (((cmo_double *)c)->d);  // see ox_toolkit.h
+     }else if (c->tag == CMO_ZZ) {
+        if ((mpz_cmp_si(mympz(c),(long int) 0x7fffffff)>0) ||
+            (mpz_cmp_si(mympz(c),(long int) -0x7fffffff)<0)) {
+          myhandler("get_double: out of int32",NULL,0,-1);
+          return(NAN);
+        }
+        return( (double) mpz_get_si(((cmo_zz *)c)->mpz));
+     }else if (c->tag == CMO_NULL) {
+         return(0);
+     }else if (c->tag == CMO_ZERO) {
+         return(0);
+     }
+     myhandler("cmo2double: not a double",NULL,0,-1);
+     return(NAN);
+ }
  void my_add_double() {
    double x,y;
-Line 270  double *get_double_list(int *length) {
+Line 295  double *get_double_list(int *length) {
 Line 270  double *get_double_list(int *length) {
 Line 295  double *get_double_list(int *length) {
    }
    return(d);
  }
+ /* get_double_list will be obsolted and will be replaced by cmo2double_list() */
+ double *cmo2double_list(int *length,cmo *c) {
+   cmo *entry;
+   cell *cellp;
+   double *d;
+   int n,i;
+   if (c == NULL) c = pop();
+   if (c->tag != CMO_LIST) {
+ //    make_error2("get_double_list",NULL,0,-1);
+     *length=-1; return(0);
+   }
+   n = *length = list_length((cmo_list *)c);
+   d = (double *) GC_malloc(sizeof(double)*(*length+1));
+   cellp = list_first((cmo_list *)c);
+   entry = cellp->cmo;
+   for (i=0; i<n; i++) {
+     if (Debug) {
+       printf("entry[%d]=",i); print_cmo(entry); printf("\n");
+     }
+     if (entry->tag == CMO_INT32) {
+       d[i]=( (double) (((cmo_int32 *)entry)->i) );
+     }else if (entry->tag == CMO_IEEE_DOUBLE_FLOAT) {
+       d[i]=((cmo_double *)entry)->d;
+     }else if (entry->tag == CMO_ZZ) {
+       d[i]=( (double) mpz_get_si(((cmo_zz *)entry)->mpz));
+     }else if (entry->tag == CMO_NULL) {
+       d[i]= 0;
+     }else {
+       fprintf(stderr,"entries of the list should be int32 or zz or double\n");
+       *length = -1;
+       myhandler("get_double_list",NULL,0,-1);
+       return(NULL);
+     }
+     cellp = list_next(cellp);
+     entry = cellp->cmo;
+   }
+   return(d);
+ }
  void show_double_list() {
    int n;
    double *d;
-Line 338  int sm_executeFunction()
+Line 401  int sm_executeFunction()
 Line 338  int sm_executeFunction()
 Line 401  int sm_executeFunction()
          call_gsl_monte_plain_miser_vegas_integrate(1);
      }else if (strcmp(func->s,"gsl_monte_vegas_integrate")==0) {
          call_gsl_monte_plain_miser_vegas_integrate(2);
+     }else if (strcmp(func->s,"gsl_odeiv_step_rk4")==0) {
+         call_gsl_odeiv_step("rk4");
+     }else if (strcmp(func->s,"gsl_sf_gamma_inc")==0) {
+         call_gsl_sf_gamma_inc();
+     }else if (strcmp(func->s,"gsl_eigen_nonsymmv")==0) {
+         call_gsl_eigen_nonsymmv();
      }else {
          push(make_error2("sm_executeFunction, unknown function",NULL,0,-1));
          return -1;
-Line 503  cmo *element_of_at(cmo *list,int k) {
+Line 572  cmo *element_of_at(cmo *list,int k) {
 Line 503  cmo *element_of_at(cmo *list,int k) {
 Line 572  cmo *element_of_at(cmo *list,int k) {
      cellp = list_next(cellp);
    }
    return(dic[k]);
+ }
+ int get_length(cmo *c) {
+   if (c->tag != CMO_LIST) {
+     return(-1);
+   }
+   return(list_length((cmo_list *)c));
  }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>