https://github.com/cran/assist
Tip revision: 866a22f739a0e84d8631044225e3676651c987f2 authored by Yuedong Wang on 22 August 2023, 07:00:02 UTC
version 3.1.9
version 3.1.9
Tip revision: 866a22f
monotone.c
#include <stdio.h>
#include <math.h>
/** cubic on [0, T] **/
static double
rc(double x, double y, long ord) {
double tmp;
tmp=(x+y-fabs(x-y))/2.0;
if(ord==1) tmp=(tmp)*(tmp)*(3.0*(x+y-tmp)-tmp)/6.0;
return(tmp);
}
/** end of kernels **/
void mono_rk(double *x, double *y, double *f,
long *n1, long *n2, long *type, double *res)
{
long i,j;
double x1, y1, sum=0.0, sum_tmp;
for(i=0;i< *n1; i++){
x1=x[i+1]-x[i];
sum=0.0;
for(j=0; j< *n2; j++){
y1=y[j+1]-y[j];
sum_tmp= 0.2777778*0.2777778*(f[3*i]*f[3*j])* rc(x[i]+x1*0.1127017, y[j]+y1*0.1127017, *type)+
0.2777778*0.4444444*((f[3*i]*f[3*j+1])* rc(x[i]+x1*0.1127017, y[j]+y1*0.5, *type )+
(f[3*i+1]*f[3*j])* rc(x[i]+x1*0.5, y[j]+y1*0.1127017, *type));
sum_tmp+=0.4444444*0.4444444*((f[3*i+1]*f[3*j+1])*rc(x[i]+x1*0.5, y[j]+y1*0.5, *type))+
0.2777778*0.2777778*((f[3*i+2]*f[3*j+2])*rc(x[i]+x1*0.8872983, y[j]+ y1*0.8872983, *type));
sum_tmp+= 0.2777778*0.2777778*((f[3*i]*f[3*j+2])*rc(x[i]+x1*0.1127017, y[j]+y1*0.8872983, *type)+
(f[3*i+2]*f[3*j])*rc(x[i]+x1*0.8872983, y[j]+y1*0.1127017, *type))+
0.4444444*0.2777778*((f[3*i+1]*f[3*j+2])*rc(x[i]+x1*0.5, y[j]+y1*0.8872983, *type)+
(f[3*i+2]*f[3*j+1])*rc(x[i]+x1*0.8872983, y[j]+y1*0.5, *type));
sum+=sum_tmp*x1*y1;
res[i*(*n2)+j]=sum;
}
}
}
void mono_f(double *x, double *y, double *f,
long *nx, long *ny, long *type, double *res)
{
long i,j;
double x1, sum=0.0;
for(i=0;i< *ny; i++){
sum=0.0;
for(j=0; j< *nx; j++){
x1=x[j+1]-x[j];
sum+=x1*(0.2777778*(f[3*j]* rc(x[j]+x1*0.1127017, y[i], *type)+
f[3*j+2]*rc(x[j]+x1*0.8872983, y[i], *type))+
0.4444444* f[3*j+1]*rc(x[j]+x1*0.5, y[i], *type));
res[i*(*nx)+j]=sum;
}
}
}
void mono_s(double *f, double *x, long *n, double *res)
{
long i;
double sum=0.0;
for(i=0;i< *n; i++){
sum += (x[i+1]-x[i])*(0.2777778*(f[3*i]+f[3*i+2])+0.4444444*f[3*i+1]);
res[i]=sum;
}
}