Octopus
oct_gsl_f.c
Go to the documentation of this file.
1/*
2 Copyright (C) 2002 M. Marques, A. Castro, A. Rubio, G. Bertsch, M. Oliveira
3
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2, or (at your option)
7 any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17 02110-1301, USA.
18
19*/
20
21#include <config.h>
22
23#include <math.h>
24#include <stdio.h>
25#include <stdlib.h>
26#include <string.h>
27
28#include <gsl/gsl_combination.h>
29#include <gsl/gsl_randist.h>
30#include <gsl/gsl_rng.h>
31#include <gsl/gsl_sf.h>
32
33#include <fortran_types.h>
34
35/* Numerical threshold for oct_bessel_k0 and oct_bessel_k1 */
36#define BESSEL_K_THRES 1.0e2
37
38/* ---------------------- Interface to GSL functions ------------------------ */
39
40/* Special Functions */
41double FC_FUNC_(oct_gamma, OCT_GAMMA)(const double *x) {
42 return gsl_sf_gamma(*x);
43}
44
45double FC_FUNC_(oct_incomplete_gamma, OCT_INCOMPLETE_GAMMA)(const double *a,
46 const double *x) {
47 return gsl_sf_gamma_inc_Q(*a, *x);
48}
49
50double FC_FUNC_(oct_sph_bessel, OCT_SPH_BESSEL)(const fint *l,
51 const double *x) {
52 if (*l == 0) {
53 return gsl_sf_bessel_j0(*x);
54 } else if (*l == 1) {
55 return gsl_sf_bessel_j1(*x);
56 } else if (*l == 2) {
57 return gsl_sf_bessel_j2(*x);
58 } else {
59 return gsl_sf_bessel_jl(*l, *x);
60 }
61}
62
63double FC_FUNC_(oct_bessel, OCT_BESSEL)(const fint *n, const double *x) {
64 return gsl_sf_bessel_Jn(*n, *x);
67double FC_FUNC_(oct_bessel_in, OCT_BESSEL_IN)(const fint *n, const double *x) {
68 return gsl_sf_bessel_In(*n, *x);
69}
70
71double FC_FUNC_(oct_bessel_j0, OCT_BESSEL_J0)(const double *x) {
72 return gsl_sf_bessel_J0(*x);
75double FC_FUNC_(oct_bessel_j1, OCT_BESSEL_J1)(const double *x) {
76 return gsl_sf_bessel_J1(*x);
77}
79double FC_FUNC_(oct_bessel_k0, OCT_BESSEL_K0)(const double *x) {
80 if (*x > BESSEL_K_THRES) {
81 return 0.0e0;
82 } else {
83 return gsl_sf_bessel_K0(*x);
84 }
85}
87double FC_FUNC_(oct_bessel_k1, OCT_BESSEL_K1)(const double *x) {
88 if (*x > BESSEL_K_THRES) {
89 return 0.0e0;
90 } else {
91 return gsl_sf_bessel_K1(*x);
92 }
94
95/* the GSL headers specify double x, not const double x */
96double FC_FUNC_(oct_erfc, OCT_ERFC)(const double *x) {
97 /* avoid floating invalids in the asymptotic limit */
98 if (*x > 20.0)
99 return 0.0;
100 if (*x < -20.0)
101 return 2.0;
102 /* otherwise call gsl */
103 return gsl_sf_erfc(*x);
104}
105
106/* the GSL headers specify double x, not const double x */
107double FC_FUNC_(oct_erf, OCT_ERF)(const double *x) {
108 /* avoid floating invalids in the asymptotic limit */
109 if (*x > 20.0)
110 return 1.0;
111 if (*x < -20.0)
112 return -1.0;
113 /* otherwise call gsl */
114 return gsl_sf_erf(*x);
117double FC_FUNC_(oct_legendre_sphplm, OCT_LEGENDRE_SPHPLM)(const fint *l,
118 const int *m,
119 const double *x) {
120 return gsl_sf_legendre_sphPlm(*l, *m, *x);
123/* generalized Laguerre polynomials */
124double FC_FUNC_(oct_sf_laguerre_n, OCT_SF_LAGUERRE_N)(const int *n,
125 const double *a,
126 const double *x) {
127 return gsl_sf_laguerre_n(*n, *a, *x);
130/* Combinations */
132void FC_FUNC_(oct_combination_init, OCT_COMBINATION_INIT)(gsl_combination **c,
133 const fint *n,
134 const fint *k) {
135 *c = gsl_combination_calloc(*n, *k);
137
138void FC_FUNC_(oct_combination_next, OCT_COMBINATION_NEXT)(gsl_combination **c,
139 fint *next) {
140 *next = gsl_combination_next(((gsl_combination *)(*c)));
141}
143void FC_FUNC_(oct_get_combination, OCT_GET_COMBINATION)(gsl_combination **c,
144 fint *comb) {
145 int i;
146 for (i = 0; i < ((gsl_combination *)(*c))->k; i++) {
147 comb[i] = (fint)((gsl_combination *)(*c))->data[i];
148 }
149}
151void FC_FUNC_(oct_combination_end, OCT_COMBINATION_END)(gsl_combination **c) {
152 gsl_combination_free(((gsl_combination *)(*c)));
153}
155/* Random Number Generation */
156void FC_FUNC_(oct_ran_init, OCT_RAN_INIT)(gsl_rng **r) {
157 gsl_rng_env_setup();
158 *r = gsl_rng_alloc(gsl_rng_default);
160
161void FC_FUNC_(oct_ran_end, OCT_RAN_END)(gsl_rng **r) { gsl_rng_free(*r); }
163/* Random Number Distributions */
164double FC_FUNC_(oct_ran_gaussian, OCT_RAN_GAUSSIAN)(const gsl_rng **r,
165 const double *sigma) {
166 return gsl_ran_gaussian(*r, *sigma);
168
169double FC_FUNC_(oct_ran_flat, OCT_RAN_FLAT)(const gsl_rng **r, const double *a,
170 const double *b) {
171 return gsl_ran_flat(*r, *a, *b);
172}
174void oct_strerror(const fint *err, char * res) {
175 const char *c;
176 c = gsl_strerror(*err);
177 strcpy(res, c);
178}
int fint
Definition: fortran_types.h:14
real(real64), dimension(:,:), allocatable sigma
S_E matrix.
Definition: pcm.F90:270
int fint
Definition: oct_gsl_f.c:12256
double FC_FUNC_(oct_gamma, OCT_GAMMA) const
Definition: oct_gsl_f.c:12269
void oct_strerror(const fint *err, char *res)
Definition: oct_gsl_f.c:12402
ptrdiff_t l
Definition: operate_inc.c:12
ptrdiff_t i
Definition: operate_inc.c:12