自学教程：C++ F_FUNC函数代码示例

int pbvv_wrap(double v, double x, double *pvf, double *pvd) {  double *vv;  double *vp;  int num;  /* NB. Indexing of DV/DP in specfun.f:PBVV starts from 0, hence +2 */  num = ABS((int)v) + 2;  vv = (double *)PyMem_Malloc(sizeof(double)*2*num);  if (vv==NULL) {    sf_error("pbvv", SF_ERROR_OTHER, "memory allocation error");    *pvf = NPY_NAN;    *pvd = NPY_NAN;    return -1;  }  vp = vv + num;  F_FUNC(pbvv,PBVV)(&v, &x, vv, vp, pvf, pvd);  PyMem_Free(vv);  return 0;}

int kelvin_wrap(double x, npy_cdouble *Be, npy_cdouble *Ke, npy_cdouble *Bep, npy_cdouble *Kep) {  int flag = 0;    if (x<0) {x=-x; flag=1;}  F_FUNC(klvna,KLVNA)(&x, F2C_CST(Be), F2C_CST(Ke), F2C_CST(Bep), F2C_CST(Kep));  ZCONVINF("klvna", *Be);  ZCONVINF("klvna", *Ke);  ZCONVINF("klvna", *Bep);  ZCONVINF("klvna", *Kep);  if (flag) {    REAL(*Bep) = -REAL(*Bep);    IMAG(*Bep) = -IMAG(*Bep);    REAL(*Ke) = NPY_NAN;    IMAG(*Ke) = NPY_NAN;    REAL(*Kep) = NPY_NAN;    IMAG(*Kep) = NPY_NAN;      }      return 0;}

int itairy_wrap(double x, double *apt, double *bpt, double *ant, double *bnt) {  double tmp;   int flag = 0;    if (x < 0) {    x = -x;    flag = 1;  }  F_FUNC(itairy,ITAIRY)(&x, apt, bpt, ant, bnt);  if (flag) {  /* negative limit -- switch signs and roles */    tmp = *apt;    *apt = -*ant;    *ant = -tmp;    tmp = *bpt;    *bpt = -*bnt;    *bnt = -tmp;  }  return 0;}

double hypU_wrap(double a, double b, double x) {  double out;  int md; /* method code --- not returned */  int isfer = 0;  F_FUNC(chgu,CHGU)(&a, &b, &x, &out, &md, &isfer);  if (out == 1e300) {      sf_error("hypU", SF_ERROR_OVERFLOW, NULL);      out = NPY_INFINITY;  }  if (isfer == 6) {    sf_error("hypU", SF_ERROR_NO_RESULT, NULL);    out = NPY_NAN;  } else if (isfer != 0) {    sf_error("hypU", isfer, NULL);    out = NPY_NAN;  }  return out;}

Py_complex cbesh_wrap2_e( double v, Py_complex z) {  int n = 1;  int kode = 2;  int m = 2;  int nz, ierr;  int sign = 1;  Py_complex cy;  if (v < 0) {    v = -v;    sign = -1;  }  F_FUNC(zbesh,ZBESH)(CADDR(z), &v, &kode, &m, &n, CADDR(cy), &nz, &ierr);  DO_MTHERR("hankel2e:", &cy);  if (sign == -1) {    cy = rotate(cy, -v);  }  return cy;}

int pbdv_wrap(double v, double x, double *pdf, double *pdd) {  double *dv;  double *dp;  int num;  /* NB. Indexing of DV/DP in specfun.f:PBDV starts from 0, hence +2 */  num = ABS((int)v) + 2;  dv = (double *)PyMem_Malloc(sizeof(double)*2*num);  if (dv==NULL) {    sf_error("pbdv", SF_ERROR_OTHER, "memory allocation error");    *pdf = NPY_NAN;    *pdd = NPY_NAN;    return -1;  }  dp = dv + num;  F_FUNC(pbdv,PBDV)(&v, &x, dv, dp, pdf, pdd);  PyMem_Free(dv);  return 0;}

double prolate_segv_wrap(double m, double n, double c){  int kd=1;  int int_m, int_n;  double cv, *eg;  if ((m<0) || (n<m) || (m!=floor(m)) || (n!=floor(n)) || ((n-m)>198)) {    return NPY_NAN;  }  int_m = (int) m;  int_n = (int) n;  eg = (double *)PyMem_Malloc(sizeof(double)*(n-m+2));  if (eg==NULL) {    printf("Warning: Memory allocation error./n");     return NPY_NAN;  }  F_FUNC(segv,SEGV)(&int_m,&int_n,&c,&kd,&cv,eg);  PyMem_Free(eg);  return cv;}

double oblate_segv_wrap(double m, double n, double c){  int kd=-1;  int int_m, int_n;  double cv, *eg;  if ((m<0) || (n<m) || (m!=floor(m)) || (n!=floor(n)) || ((n-m)>198)) {    return NPY_NAN;  }  int_m = (int) m;  int_n = (int) n;  eg = (double *)PyMem_Malloc(sizeof(double)*(n-m+2));  if (eg==NULL) {    sf_error("oblate_segv", SF_ERROR_OTHER, "memory allocation error");    return NPY_NAN;  }  F_FUNC(segv,SEGV)(&int_m,&int_n,&c,&kd,&cv,eg);  PyMem_Free(eg);  return cv;}

npy_cdouble cbesh_wrap2_e( double v, npy_cdouble z) {  int n = 1;  int kode = 2;  int m = 2;  int nz, ierr;  int sign = 1;  npy_cdouble cy;  cy.real = NPY_NAN;  cy.imag = NPY_NAN;  if (v < 0) {    v = -v;    sign = -1;  }  F_FUNC(zbesh,ZBESH)(CADDR(z), &v, &kode, &m, &n, CADDR(cy), &nz, &ierr);  DO_SFERR("hankel2e:", &cy);  if (sign == -1) {    cy = rotate(cy, -v);  }  return cy;}

Py_complex cbesk_wrap_e( double v, Py_complex z) {  int n = 1;  int kode = 2;  int nz, ierr;  Py_complex cy;  if (v < 0) {    /* K_v == K_{-v} even for non-integer v */    v = -v;  }  F_FUNC(zbesk,ZBESK)(CADDR(z), &v, &kode, &n, CADDR(cy), &nz, &ierr);  DO_MTHERR("kve:", &cy);  if (ierr == 2) {    if (z.real >= 0 && z.imag == 0) {      /* overflow */      cy.real = NPY_INFINITY;      cy.imag = 0;    }  }  return cy;}

double sem_cva_wrap(double m, double q) {  int int_m, kd=4;  double out;  if ((m <= 0) || (m != floor(m))) {    sf_error("cem_cva", SF_ERROR_DOMAIN, NULL);    return NPY_NAN;  }  int_m = (int)m;  if (q < 0) {    /* http://dlmf.nist.gov/28.2#E26 */    if (int_m % 2 == 0) {      return sem_cva_wrap(m, -q);    }    else {      return cem_cva_wrap(m, -q);    }  }  if (int_m % 2) kd=3;  F_FUNC(cva2,CVA2)(&kd, &int_m, &q, &out);  return out;}

int sem_wrap(double m, double q, double x, double *csf, double *csd){  int int_m, kf=2, sgn;  double f, d;  if ((m < 0) || (m != floor(m))) {    *csf = NPY_NAN;    *csd = NPY_NAN;    sf_error("sem", SF_ERROR_DOMAIN, NULL);    return -1;  }  int_m = (int)m;  if (int_m == 0) {    *csf = 0;    *csd = 0;    return 0;  }  if (q < 0) {      /* http://dlmf.nist.gov/28.2#E34 */      if (int_m % 2 == 0) {        sgn = ((int_m/2) % 2 == 0) ? -1 : 1;        sem_wrap(m, -q, 90 - x, &f, &d);        *csf =  sgn * f;        *csd = -sgn * d;        return 0;      }      else {        sgn = ((int_m/2) % 2 == 0) ? 1 : -1;        cem_wrap(m, -q, 90 - x, &f, &d);        *csf =  sgn * f;        *csd = -sgn * d;        return 0;      }  }  F_FUNC(mtu0,MTU0)(&kf,&int_m, &q, &x, csf, csd);  return 0;}

/******************************* end of sbesjy *******************************//*eof body*//******************* See f2py2e/f90mod_rules.py: buildhooks *******************//*need_f90modhooks*//************** See f2py2e/rules.py: module_rules['modulebody'] **************//******************* See f2py2e/common_rules.py: buildhooks *******************//*need_commonhooks*//**************************** See f2py2e/rules.py ****************************/static FortranDataDef f2py_routine_defs[] = {  {"rotcoef",-1,{{-1}},0,(char *)F_FUNC(rotcoef,ROTCOEF),(f2py_init_func)f2py_rout_uts_scsmfo_rotcoef,doc_f2py_rout_uts_scsmfo_rotcoef},  {"asmfr",-1,{{-1}},0,(char *)F_FUNC(asmfr,ASMFR),(f2py_init_func)f2py_rout_uts_scsmfo_asmfr,doc_f2py_rout_uts_scsmfo_asmfr},  {"ms_radial_fields",-1,{{-1}},0,(char *)F_FUNC_US(ms_radial_fields,MS_RADIAL_FIELDS),(f2py_init_func)f2py_rout_uts_scsmfo_ms_radial_fields,doc_f2py_rout_uts_scsmfo_ms_radial_fields},  {"asm",-1,{{-1}},0,(char *)F_FUNC(asm,ASM),(f2py_init_func)f2py_rout_uts_scsmfo_asm,doc_f2py_rout_uts_scsmfo_asm},  {"sbesjy",-1,{{-1}},0,(char *)F_FUNC(sbesjy,SBESJY),(f2py_init_func)f2py_rout_uts_scsmfo_sbesjy,doc_f2py_rout_uts_scsmfo_sbesjy},/*eof routine_defs*/  {NULL}};static PyMethodDef f2py_module_methods[] = {  {NULL,NULL}};#if PY_VERSION_HEX >= 0x03000000

/******************************** end of nnls ********************************//*eof body*//******************* See f2py2e/f90mod_rules.py: buildhooks *******************//*need_f90modhooks*//************** See f2py2e/rules.py: module_rules['modulebody'] **************//******************* See f2py2e/common_rules.py: buildhooks *******************//*need_commonhooks*//**************************** See f2py2e/rules.py ****************************/static FortranDataDef f2py_routine_defs[] = {  {"nnls",-1,{{-1}},0,(char *)F_FUNC(nnls,NNLS),(f2py_init_func)f2py_rout__nnls_nnls,doc_f2py_rout__nnls_nnls},/*eof routine_defs*/  {NULL}};static PyMethodDef f2py_module_methods[] = {  {NULL,NULL}};#if PY_VERSION_HEX >= 0x03000000static struct PyModuleDef moduledef = {  PyModuleDef_HEAD_INIT,  "_nnls",  NULL,

//.........这里部分代码省略.........      if ((ifixx =           (PyArrayObject *) PyArray_CopyFromObject(pifixx, NPY_INT, 1,                                                    2)) == NULL)        {          PYERR(PyExc_ValueError,                "could not convert ifixx to a suitable array");        }      if (ifixx->nd == 1 && ifixx->dimensions[0] == m)        {          ldifx = 1;        }      else if (ifixx->nd == 1 && ifixx->dimensions[0] == n && m == 1)        {          ldifx = n;        }      else if (ifixx->nd == 2 && ifixx->dimensions[0] == m               && ifixx->dimensions[1] == n)        {          ldifx = n;        }      else        {          PYERR(PyExc_ValueError,                "could not convert ifixx to a suitable array");        }    }                           /* ifixx */  if (errfile != NULL)    {      /* call FORTRAN's OPEN to open the file with a logical unit of 18 */      lunerr = 18;      F_FUNC(dluno,DLUNO)(&lunerr, errfile, lerrfile);    }  if (rptfile != NULL)    {      /* call FORTRAN's OPEN to open the file with a logical unit of 19 */      lunrpt = 19;      F_FUNC(dluno,DLUNO)(&lunrpt, rptfile, lrptfile);    }  if (pstpb == NULL)    {      dim1[0] = np;      stpb = (PyArrayObject *) PyArray_SimpleNew(1, dim1, NPY_DOUBLE);      *(double *)(stpb->data) = 0.0;    }  else                          /* pstpb is a sequence */    {      if ((stpb =           (PyArrayObject *) PyArray_CopyFromObject(pstpb, NPY_DOUBLE, 1,                                                    1)) == NULL          || stpb->dimensions[0] != np)        {          PYERR(PyExc_ValueError,                "could not convert stpb to a suitable array");        }    }                           /* stpb */  if (pstpd == NULL)    {      dim2[0] = 1;      dim2[1] = m;      stpd = (PyArrayObject *) PyArray_SimpleNew(2, dim2, NPY_DOUBLE);

/* generates Python output from the raw output from DODRC */PyObject *gen_output(int n, int m, int np, int nq, int ldwe, int ld2we,                     PyArrayObject * beta, PyArrayObject * work,                     PyArrayObject * iwork, int isodr, int info,                     int full_output){  PyArrayObject *sd_beta, *cov_beta;  int delta, eps, xplus, fn, sd, vcv, rvar, wss, wssde, wssep, rcond;  int eta, olmav, tau, alpha, actrs, pnorm, rnors, prers, partl, sstol;  int taufc, apsma, betao, betac, betas, betan, s, ss, ssf, qraux, u;  int fs, fjacb, we1, diff, delts, deltn, t, tt, omega, fjacd;  int wrk1, wrk2, wrk3, wrk4, wrk5, wrk6, wrk7, lwkmn;  PyObject *retobj;  npy_intp dim1[1], dim2[2];  if (info == 50005) {      /* fatal error in fcn call; return NULL to propogate the exception */      return NULL;  }  lwkmn = work->dimensions[0];  F_FUNC(dwinf,DWINF)(&n, &m, &np, &nq, &ldwe, &ld2we, &isodr,        &delta, &eps, &xplus, &fn, &sd, &vcv, &rvar, &wss, &wssde,        &wssep, &rcond, &eta, &olmav, &tau, &alpha, &actrs, &pnorm,        &rnors, &prers, &partl, &sstol, &taufc, &apsma, &betao, &betac,        &betas, &betan, &s, &ss, &ssf, &qraux, &u, &fs, &fjacb, &we1,        &diff, &delts, &deltn, &t, &tt, &omega, &fjacd, &wrk1, &wrk2,        &wrk3, &wrk4, &wrk5, &wrk6, &wrk7, &lwkmn);  /* convert FORTRAN indices to C indices */  delta--;  eps--;  xplus--;  fn--;  sd--;  vcv--;  rvar--;  wss--;  wssde--;  wssep--;  rcond--;  eta--;  olmav--;  tau--;  alpha--;  actrs--;  pnorm--;  rnors--;  prers--;  partl--;  sstol--;  taufc--;  apsma--;  betao--;  betac--;  betas--;  betan--;  s--;  ss--;  ssf--;  qraux--;  u--;  fs--;  fjacb--;  we1--;  diff--;  delts--;  deltn--;  t--;  tt--;  omega--;  fjacd--;  wrk1--;  wrk2--;  wrk3--;  wrk4--;  wrk5--;  wrk6--;  wrk7--;  dim1[0] = beta->dimensions[0];  sd_beta = (PyArrayObject *) PyArray_SimpleNew(1, dim1, NPY_DOUBLE);  dim2[0] = beta->dimensions[0];  dim2[1] = beta->dimensions[0];  cov_beta = (PyArrayObject *) PyArray_SimpleNew(2, dim2, NPY_DOUBLE);  memcpy(sd_beta->data, (void *)((double *)(work->data) + sd),         np * sizeof(double));  memcpy(cov_beta->data, (void *)((double *)(work->data) + vcv),         np * np * sizeof(double));  if (!full_output)    {      retobj = Py_BuildValue("OOO", PyArray_Return(beta),                             PyArray_Return(sd_beta),//.........这里部分代码省略.........

/******************************** end of fcopy ********************************//*eof body*//******************* See f2py2e/f90mod_rules.py: buildhooks *******************//*need_f90modhooks*//************** See f2py2e/rules.py: module_rules['modulebody'] **************//******************* See f2py2e/common_rules.py: buildhooks *******************//*need_commonhooks*//**************************** See f2py2e/rules.py ****************************/static FortranDataDef f2py_routine_defs[] = {  {"fcopy",-1,{{-1}},0,(char *)F_FUNC(fcopy,FCOPY),(f2py_init_func)f2py_rout_fcopy_fcopy,doc_f2py_rout_fcopy_fcopy},/*eof routine_defs*/  {NULL}};static PyMethodDef f2py_module_methods[] = {  {NULL,NULL}};PyMODINIT_FUNC initfcopy(void) {  int i;  PyObject *m,*d, *s;  m = fcopy_module = Py_InitModule("fcopy", f2py_module_methods);  PyFortran_Type.ob_type = &PyType_Type;

static void f2py_init_blo10(void) {  F_FUNC(f2pyinitblo10,F2PYINITBLO10)(f2py_setup_blo10);}

};static void f2py_setup_dkblck(char *ivls) {  int i_f2py=0;  f2py_dkblck_def[i_f2py++].data = ivls;}extern void F_FUNC(f2pyinitdkblck,F2PYINITDKBLCK)(void(*)(char*));static void f2py_init_dkblck(void) {  F_FUNC(f2pyinitdkblck,F2PYINITDKBLCK)(f2py_setup_dkblck);}/*need_commonhooks*//**************************** See f2py2e/rules.py ****************************/static FortranDataDef f2py_routine_defs[] = {  {"mvnun",-1,{{-1}},0,(char *)F_FUNC(mvnun,MVNUN),(f2py_init_func)f2py_rout_mvn_mvnun,doc_f2py_rout_mvn_mvnun},  {"mvndst",-1,{{-1}},0,(char *)F_FUNC(mvndst,MVNDST),(f2py_init_func)f2py_rout_mvn_mvndst,doc_f2py_rout_mvn_mvndst},/*eof routine_defs*/  {NULL}};static PyMethodDef f2py_module_methods[] = {  {NULL,NULL}};#if PY_VERSION_HEX >= 0x03000000static struct PyModuleDef moduledef = {  PyModuleDef_HEAD_INIT,  "mvn",

static void f2py_init_findrlat(void) {  F_FUNC(f2pyinitfindrlat,F2PYINITFINDRLAT)(f2py_setup_findrlat);}

static void f2py_init_qtop(void) {  F_FUNC(f2pyinitqtop,F2PYINITQTOP)(f2py_setup_qtop);}

static void f2py_init_iounit(void) {  F_FUNC(f2pyinitiounit,F2PYINITIOUNIT)(f2py_setup_iounit);}

static void f2py_init_const2(void) {  F_FUNC(f2pyinitconst2,F2PYINITCONST2)(f2py_setup_const2);}

static void f2py_init_blote(void) {  F_FUNC(f2pyinitblote,F2PYINITBLOTE)(f2py_setup_blote);}

static void f2py_init_const1(void) {  F_FUNC(f2pyinitconst1,F2PYINITCONST1)(f2py_setup_const1);}

npy_cdouble cerf_wrap(npy_cdouble z) {  npy_cdouble outz;  F_FUNC(cerror,CERROR)(&z, &outz);  return outz;}

static void f2py_init_dkblck(void) {  F_FUNC(f2pyinitdkblck,F2PYINITDKBLCK)(f2py_setup_dkblck);}

static void f2py_init_argexp(void) {  F_FUNC(f2pyinitargexp,F2PYINITARGEXP)(f2py_setup_argexp);}

static void f2py_init_block3(void) {  F_FUNC(f2pyinitblock3,F2PYINITBLOCK3)(f2py_setup_block3);}

static void f2py_init_blo11(void) {  F_FUNC(f2pyinitblo11,F2PYINITBLO11)(f2py_setup_blo11);}