1 /***************************************************************************
2  * complex.cpp is part of Math Graphic Library
3  * Copyright (C) 2007-2016 Alexey Balakin <mathgl.abalakin@gmail.ru>       *
4  *                                                                         *
5  *   This program is free software; you can redistribute it and/or modify  *
6  *   it under the terms of the GNU Lesser General Public License  as       *
7  *   published by the Free Software Foundation; either version 3 of the    *
8  *   License, or (at your option) any later version.                       *
9  *                                                                         *
10  *   This program is distributed in the hope that it will be useful,       *
11  *   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
12  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
13  *   GNU General Public License for more details.                          *
14  *                                                                         *
15  *   You should have received a copy of the GNU Lesser General Public     *
16  *   License along with this program; if not, write to the                 *
17  *   Free Software Foundation, Inc.,                                       *
18  *   59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.             *
19  ***************************************************************************/
20 #include "mgl2/datac.h"
21 #include "mgl2/evalc.h"
22 #include "mgl2/thread.h"
23 
24 #include "interp.hpp"
25 #define mgl2 	mreal(2)
26 #define mgl3 	mreal(3)
27 #define mgl4 	mreal(4)
28 
29 //-----------------------------------------------------------------------------
mglStartThreadC(void * (* func)(void *),void (* post)(mglThreadC *,dual *),long n,dual * a,const dual * b,const dual * c,const long * p,const void * v,const dual * d,const dual * e,const char * s)30 void MGL_EXPORT mglStartThreadC(void *(*func)(void *), void (*post)(mglThreadC *,dual *), long n,
31 					dual *a, const dual *b, const dual *c, const long *p,
32 					const void *v, const dual *d, const dual *e, const char *s)
33 {
34 	if(!func)	return;
35 #if MGL_HAVE_PTHREAD
36 	if(mglNumThr<1)	mgl_set_num_thr(0);
37 	if(mglNumThr>1)
38 	{
39 		pthread_t *tmp=new pthread_t[mglNumThr];
40 		mglThreadC *par=new mglThreadC[mglNumThr];
41 		for(long i=0;i<mglNumThr;i++)	// put parameters into the structure
42 		{	par[i].n=n;	par[i].a=a;	par[i].b=b;	par[i].c=c;	par[i].d=d;
43 			par[i].p=p;	par[i].v=v;	par[i].s=s;	par[i].e=e;	par[i].id=i;	}
44 		for(long i=0;i<mglNumThr;i++)	pthread_create(tmp+i, 0, func, par+i);
45 		for(long i=0;i<mglNumThr;i++)	pthread_join(tmp[i], 0);
46 		if(post)	post(par,a);
47 		delete []tmp;	delete []par;
48 	}
49 	else
50 #endif
51 	{
52 		mglNumThr = 1;
53 		mglThreadC par;
54 		par.n=n;	par.a=a;	par.b=b;	par.c=c;	par.d=d;
55 		par.p=p;	par.v=v;	par.s=s;	par.e=e;	par.id=0;
56 		func(&par);
57 		if(post)	post(&par,a);
58 	}
59 }
60 //-----------------------------------------------------------------------------
mglStartThreadV(void * (* func)(void *),long n,dual * a,const void * b,const void * c,const long * p,const void * v,const mreal * d)61 void MGL_EXPORT mglStartThreadV(void *(*func)(void *), long n, dual *a, const void *b,
62 					const void *c, const long *p, const void *v, const mreal *d)
63 {
64 	if(!func)	return;
65 #if MGL_HAVE_PTHREAD
66 	if(mglNumThr<1)	mgl_set_num_thr(0);
67 	if(mglNumThr>1)
68 	{
69 		pthread_t *tmp=new pthread_t[mglNumThr];
70 		mglThreadV *par=new mglThreadV[mglNumThr];
71 		for(long i=0;i<mglNumThr;i++)	// put parameters into the structure
72 		{	par[i].n=n;	par[i].a=0;	par[i].b=b;	par[i].c=c;	par[i].d=d;
73 			par[i].p=p;	par[i].v=v;	par[i].id=i;par[i].aa=a;	}
74 		for(long i=0;i<mglNumThr;i++)	pthread_create(tmp+i, 0, func, par+i);
75 		for(long i=0;i<mglNumThr;i++)	pthread_join(tmp[i], 0);
76 		delete []tmp;	delete []par;
77 	}
78 	else
79 #endif
80 	{
81 		mglNumThr = 1;
82 		mglThreadV par;
83 		par.n=n;	par.a=0;	par.b=b;	par.c=c;	par.d=d;
84 		par.p=p;	par.v=v;	par.id=0;	par.aa=a;
85 		func(&par);
86 	}
87 }
88 //-----------------------------------------------------------------------------
mgl_expi(mdual a)89 cmdual MGL_EXPORT_CONST mgl_expi(mdual a)
90 {
91 	return mdual(exp(dual(0,1)*dual(a)));
92 }
93 //-----------------------------------------------------------------------------
mgl_csmth_x(void * par)94 static void *mgl_csmth_x(void *par)
95 {
96 	mglThreadC *t=(mglThreadC *)par;
97 	long nx=t->p[0], kind=t->p[2];
98 	dual *b=t->a;
99 	const dual *a=t->b;
100 	if(kind>0)
101 #if !MGL_HAVE_PTHREAD
102 #pragma omp parallel for
103 #endif
104 		for(long i=t->id;i<t->n;i+=mglNumThr)
105 			if(mgl_isnum(a[i]))	// bypass NAN values
106 			{
107 				long j = i%nx, nk = 2*kind+1;
108 				for(long k=-kind;k<=kind;k++)
109 					if(j+k>=0 && j+k<nx && mgl_isnum(a[i+k])) b[i] += a[i+k];	else nk--;
110 				b[i] /= mreal(nk);
111 			}	else	b[i] = a[i];
112 	else if(kind==-1)
113 #if !MGL_HAVE_PTHREAD
114 #pragma omp parallel for
115 #endif
116 		for(long i=t->id;i<t->n;i+=mglNumThr)
117 		{
118 			long j = i%nx;
119 			if(j>1 && j<nx-2)	b[i] = (mreal(12)*a[i-2] - mreal(3)*a[i-1] + mreal(17)*a[i] - mreal(3)*a[i+1] + mreal(12)*a[i+2])/mreal(35);
120 			else if(j==1 || j==nx-2)	b[i] = (a[i-1] + a[i] + a[i+1])/mreal(3);
121 			else	b[i] = a[i];
122 		}
123 	return 0;
124 }
mgl_csmth_y(void * par)125 static void *mgl_csmth_y(void *par)
126 {
127 	mglThreadC *t=(mglThreadC *)par;
128 	long nx=t->p[0],ny=t->p[1], kind=t->p[2];
129 	dual *b=t->a;
130 	const dual *a=t->b;
131 	if(kind>0)
132 #if !MGL_HAVE_PTHREAD
133 #pragma omp parallel for
134 #endif
135 		for(long i=t->id;i<t->n;i+=mglNumThr)
136 			if(mgl_isnum(a[i]))	// bypass NAN values
137 			{
138 				long j = (i/nx)%ny, nk = 2*kind+1;
139 				for(long k=-kind;k<=kind;k++)
140 					if(j+k>=0 && j+k<ny && mgl_isnum(a[i+k*nx])) b[i] += a[i+k*nx];	else nk--;
141 				b[i] /= mreal(nk);
142 			}	else	b[i] = a[i];
143 	else
144 #if !MGL_HAVE_PTHREAD
145 #pragma omp parallel for
146 #endif
147 		for(long i=t->id;i<t->n;i+=mglNumThr)
148 		{
149 			long j = (i/nx)%ny;
150 			if(j>1 && j<ny-2)	b[i] = (mreal(12)*a[i-2*nx] - mreal(3)*a[i-nx] + mreal(17)*a[i] - mreal(3)*a[i+nx] + mreal(12)*a[i+2*nx])/mreal(35);
151 			else if(j==1 || j==ny-2)	b[i] = (a[i-nx] + a[i] + a[i+nx])/mreal(3);
152 			else	b[i] = a[i];
153 		}
154 	return 0;
155 }
mgl_csmth_z(void * par)156 static void *mgl_csmth_z(void *par)
157 {
158 	mglThreadC *t=(mglThreadC *)par;
159 	long nn=t->p[0]*t->p[1], nz=t->n/nn, kind=t->p[2];
160 	dual *b=t->a;
161 	const dual *a=t->b;
162 	if(kind>0)
163 #if !MGL_HAVE_PTHREAD
164 #pragma omp parallel for
165 #endif
166 		for(long i=t->id;i<t->n;i+=mglNumThr)
167 			if(mgl_isnum(a[i]))	// bypass NAN values
168 			{
169 				long j = i/nn, nk = 2*kind+1;
170 				for(long k=-kind;k<=kind;k++)
171 					if(j+k>=0 && j+k<nz && mgl_isnum(a[i+k*nn])) b[i] += a[i+k*nn];	else nk--;
172 				b[i] /= mreal(nk);
173 			}	else	b[i] = a[i];
174 	else
175 #if !MGL_HAVE_PTHREAD
176 #pragma omp parallel for
177 #endif
178 		for(long i=t->id;i<t->n;i+=mglNumThr)
179 		{
180 			long j = i/nn;
181 			if(j>1 && j<nz-2)	b[i] = (mreal(12)*a[i-2*nn] - mreal(3)*a[i-nn] + mreal(17)*a[i] - mreal(3)*a[i+nn] + mreal(12)*a[i+2*nn])/mreal(35);
182 			else if(j==1 || j==nz-2)	b[i] = (a[i-nn] + a[i] + a[i+nn])/mreal(3);
183 			else	b[i] = a[i];
184 		}
185 	return 0;
186 }
mgl_datac_smooth(HADT d,const char * dirs,mreal)187 void MGL_EXPORT mgl_datac_smooth(HADT d, const char *dirs, mreal )
188 {
189 	long Type = -1;
190 	if(mglchr(dirs,'0'))	return;
191 	bool xdir=mglchr(dirs,'x'), ydir=mglchr(dirs,'y'), zdir=mglchr(dirs,'z');
192 	if(!xdir && !ydir && !zdir)	xdir=ydir=zdir=true;
193 	if(mglchr(dirs,'d'))
194 	{
195 		if(mglchr(dirs,'1'))	Type = 1;
196 		if(mglchr(dirs,'2'))	Type = 2;
197 		if(mglchr(dirs,'3'))	Type = 3;
198 		if(mglchr(dirs,'4'))	Type = 4;
199 		if(mglchr(dirs,'5'))	Type = 5;
200 		if(mglchr(dirs,'6'))	Type = 6;
201 		if(mglchr(dirs,'7'))	Type = 7;
202 		if(mglchr(dirs,'8'))	Type = 8;
203 		if(mglchr(dirs,'9'))	Type = 9;
204 	}
205 	else
206 	{
207 		if(mglchr(dirs,'1'))	return;
208 		if(mglchr(dirs,'3'))	Type = 1;
209 		if(mglchr(dirs,'5'))	Type = 2;
210 	}
211 	long nx=d->nx,ny=d->ny,nz=d->nz;
212 //	if(Type == SMOOTH_NONE)	return;
213 	long p[3]={nx,ny,Type};
214 	dual *b = new dual[nx*ny*nz];
215 	memset(b,0,nx*ny*nz*sizeof(dual));
216 	if(nx>4 && xdir)
217 	{
218 		mglStartThreadC(mgl_csmth_x,0,nx*ny*nz,b,d->a,0,p);
219 		memcpy(d->a,b,nx*ny*nz*sizeof(dual));
220 		memset(b,0,nx*ny*nz*sizeof(dual));
221 	}
222 	if(ny>4 && ydir)
223 	{
224 		mglStartThreadC(mgl_csmth_y,0,nx*ny*nz,b,d->a,0,p);
225 		memcpy(d->a,b,nx*ny*nz*sizeof(dual));
226 		memset(b,0,nx*ny*nz*sizeof(dual));
227 	}
228 	if(nz>4 && zdir)
229 	{
230 		mglStartThreadC(mgl_csmth_z,0,nx*ny*nz,b,d->a,0,p);
231 		memcpy(d->a,b,nx*ny*nz*sizeof(dual));
232 	}
233 	delete []b;
234 }
mgl_datac_smooth_(uintptr_t * d,const char * dir,mreal * delta,int l)235 void MGL_EXPORT mgl_datac_smooth_(uintptr_t *d, const char *dir, mreal *delta,int l)
236 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
237 	mgl_datac_smooth(_DC_,s,*delta);		delete []s;	}
238 //-----------------------------------------------------------------------------
mgl_ccsum_z(void * par)239 static void *mgl_ccsum_z(void *par)
240 {
241 	mglThreadC *t=(mglThreadC *)par;
242 	long nz=t->p[2], nn=t->n;
243 	dual *b=t->a;
244 	const dual *a=t->b;
245 #if !MGL_HAVE_PTHREAD
246 #pragma omp parallel for
247 #endif
248 	for(long i=t->id;i<nn;i+=mglNumThr)
249 	{
250 		b[i] = a[i];
251 		for(long j=1;j<nz;j++)	b[i+j*nn] = b[i+j*nn-nn] + a[i+j*nn];
252 	}
253 	return 0;
254 }
mgl_ccsum_y(void * par)255 static void *mgl_ccsum_y(void *par)
256 {
257 	mglThreadC *t=(mglThreadC *)par;
258 	long nx=t->p[0], ny=t->p[1], nn=t->n;
259 	dual *b=t->a;
260 	const dual *a=t->b;
261 #if !MGL_HAVE_PTHREAD
262 #pragma omp parallel for
263 #endif
264 	for(long i=t->id;i<nn;i+=mglNumThr)
265 	{
266 		long k = (i%nx)+nx*ny*(i/nx);		b[k] = a[k];
267 		for(long j=1;j<ny;j++)	b[k+j*nx] = b[k+j*nx-nx] + a[k+nx*j];
268 	}
269 	return 0;
270 }
mgl_ccsum_x(void * par)271 static void *mgl_ccsum_x(void *par)
272 {
273 	mglThreadC *t=(mglThreadC *)par;
274 	long nx=t->p[0], nn=t->n;
275 	dual *b=t->a;
276 	const dual *a=t->b;
277 #if !MGL_HAVE_PTHREAD
278 #pragma omp parallel for
279 #endif
280 	for(long i=t->id;i<nn;i+=mglNumThr)
281 	{
282 		long k = i*nx;			b[k] = a[k];
283 		for(long j=1;j<nx;j++)	b[j+k] = b[j+k-1] + a[j+k];
284 	}
285 	return 0;
286 }
mgl_datac_cumsum(HADT d,const char * dir)287 void MGL_EXPORT mgl_datac_cumsum(HADT d, const char *dir)
288 {
289 	if(!dir || *dir==0)	return;
290 	long nx=d->nx,ny=d->ny,nz=d->nz,nn=nx*ny*nz;
291 	long p[3]={nx,ny,nz};
292 	dual *b = new dual[nn];
293 	memcpy(b,d->a,nn*sizeof(dual));
294 	if(strchr(dir,'z') && nz>1)
295 	{
296 		mglStartThreadC(mgl_ccsum_z,0,nx*ny,b,d->a,0,p);
297 		memcpy(d->a,b,nn*sizeof(dual));
298 	}
299 	if(strchr(dir,'y') && ny>1)
300 	{
301 		mglStartThreadC(mgl_ccsum_y,0,nx*nz,b,d->a,0,p);
302 		memcpy(d->a,b,nn*sizeof(dual));
303 	}
304 	if(strchr(dir,'x') && nx>1)
305 	{
306 		mglStartThreadC(mgl_ccsum_x,0,nz*ny,b,d->a,0,p);
307 		memcpy(d->a,b,nn*sizeof(dual));
308 	}
309 	delete []b;
310 }
mgl_datac_cumsum_(uintptr_t * d,const char * dir,int l)311 void MGL_EXPORT mgl_datac_cumsum_(uintptr_t *d, const char *dir,int l)
312 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
313 	mgl_datac_cumsum(_DC_,s);	delete []s;	}
314 //-----------------------------------------------------------------------------
mgl_cint_z(void * par)315 static void *mgl_cint_z(void *par)
316 {
317 	mglThreadC *t=(mglThreadC *)par;
318 	long nz=t->p[2], nn=t->n;
319 	dual *b=t->a, dd=0.5/nz;
320 	const dual *a=t->b;
321 #if !MGL_HAVE_PTHREAD
322 #pragma omp parallel for
323 #endif
324 	for(long i=t->id;i<nn;i+=mglNumThr)
325 	{
326 		b[i] = 0;
327 		for(long j=1;j<nz;j++)	b[i+j*nn] = b[i+j*nn-nn] + (a[i+nn*j]+a[i+j*nn-nn])*dd;
328 	}
329 	return 0;
330 }
mgl_cint_y(void * par)331 static void *mgl_cint_y(void *par)
332 {
333 	mglThreadC *t=(mglThreadC *)par;
334 	long nx=t->p[0], ny=t->p[1], nn=t->n;
335 	dual *b=t->a, dd=0.5/ny;
336 	const dual *a=t->b;
337 #if !MGL_HAVE_PTHREAD
338 #pragma omp parallel for
339 #endif
340 	for(long i=t->id;i<nn;i+=mglNumThr)
341 	{
342 		long k = (i%nx)+nx*ny*(i/nx);	b[k] = 0;
343 		for(long j=1;j<ny;j++)	b[k+j*nx] = b[k+j*nx-nx] + (a[k+j*nx]+a[k+j*nx-nx])*dd;
344 	}
345 	return 0;
346 }
mgl_cint_x(void * par)347 static void *mgl_cint_x(void *par)
348 {
349 	mglThreadC *t=(mglThreadC *)par;
350 	long nx=t->p[0], nn=t->n;
351 	dual *b=t->a, dd=0.5/nx;
352 	const dual *a=t->b;
353 #if !MGL_HAVE_PTHREAD
354 #pragma omp parallel for
355 #endif
356 	for(long i=t->id;i<nn;i+=mglNumThr)
357 	{
358 		long k = i*nx;			b[k] = 0;
359 		for(long j=1;j<nx;j++)	b[j+k] = b[j+k-1] + (a[j+k]+a[j+k-1])*dd;
360 	}
361 	return 0;
362 }
mgl_datac_integral(HADT d,const char * dir)363 void MGL_EXPORT mgl_datac_integral(HADT d, const char *dir)
364 {
365 	if(!dir || *dir==0)	return;
366 	long nx=d->nx,ny=d->ny,nz=d->nz,nn=nx*ny*nz;
367 	long p[3]={nx,ny,nz};
368 	dual *b = new dual[nn];
369 	memcpy(b,d->a,nn*sizeof(dual));
370 	if(strchr(dir,'z') && nz>1)
371 	{
372 		mglStartThreadC(mgl_cint_z,0,nx*ny,b,d->a,0,p);
373 		memcpy(d->a,b,nn*sizeof(dual));
374 	}
375 	if(strchr(dir,'y') && ny>1)
376 	{
377 		mglStartThreadC(mgl_cint_y,0,nx*nz,b,d->a,0,p);
378 		memcpy(d->a,b,nn*sizeof(dual));
379 	}
380 	if(strchr(dir,'x') && nx>1)
381 	{
382 		mglStartThreadC(mgl_cint_x,0,nz*ny,b,d->a,0,p);
383 		memcpy(d->a,b,nn*sizeof(dual));
384 	}
385 	delete []b;
386 }
mgl_datac_integral_(uintptr_t * d,const char * dir,int l)387 void MGL_EXPORT mgl_datac_integral_(uintptr_t *d, const char *dir,int l)
388 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
389 	mgl_datac_integral(_DC_,s);	delete []s;	}
390 //-----------------------------------------------------------------------------
mgl_cdif_z(void * par)391 static void *mgl_cdif_z(void *par)
392 {
393 	mglThreadC *t=(mglThreadC *)par;
394 	long nz=t->p[2], nn=t->n;
395 	dual *b=t->a, dd=0.5*nz;
396 	const dual *a=t->b;
397 #if !MGL_HAVE_PTHREAD
398 #pragma omp parallel for
399 #endif
400 	for(long i=t->id;i<nn;i+=mglNumThr)
401 	{
402 		b[i] = -(mgl3*a[i]-mgl4*a[i+nn]+a[i+2*nn])*dd;
403 		b[i+(nz-1)*nn] = (mgl3*a[i+(nz-1)*nn]-mgl4*a[i+(nz-2)*nn]+a[i+(nz-3)*nn])*dd;
404 		for(long j=1;j<nz-1;j++)		b[i+j*nn] = (a[i+j*nn+nn]-a[i+j*nn-nn])*dd;
405 	}
406 	return 0;
407 }
mgl_cdif_y(void * par)408 static void *mgl_cdif_y(void *par)
409 {
410 	mglThreadC *t=(mglThreadC *)par;
411 	long nx=t->p[0], ny=t->p[1], nn=t->n;
412 	dual *b=t->a, dd=0.5*ny;
413 	const dual *a=t->b;
414 #if !MGL_HAVE_PTHREAD
415 #pragma omp parallel for
416 #endif
417 	for(long i=t->id;i<nn;i+=mglNumThr)
418 	{
419 		long k = (i%nx)+nx*ny*(i/nx);
420 		b[k] = -(mgl3*a[k]-mgl4*a[k+nx]+a[k+2*nx])*dd;
421 		b[k+(ny-1)*nx] = (mgl3*a[k+(ny-1)*nx]-mgl4*a[k+(ny-2)*nx]+a[k+(ny-3)*nx])*dd;
422 		for(long j=1;j<ny-1;j++)	b[k+j*nx] = (a[k+j*nx+nx]-a[k+j*nx-nx])*dd;
423 	}
424 	return 0;
425 }
mgl_cdif_x(void * par)426 static void *mgl_cdif_x(void *par)
427 {
428 	mglThreadC *t=(mglThreadC *)par;
429 	long nx=t->p[0], nn=t->n;
430 	dual *b=t->a, dd=0.5*nx;
431 	const dual *a=t->b;
432 #if !MGL_HAVE_PTHREAD
433 #pragma omp parallel for
434 #endif
435 	for(long i=t->id;i<nn;i+=mglNumThr)
436 	{
437 		long k = i*nx;
438 		b[k] = -(mgl3*a[k]-mgl4*a[k+1]+a[k+2])*dd;
439 		b[k+nx-1] = (mgl3*a[k+nx-1]-mgl4*a[k+nx-2]+a[k+nx-3])*dd;
440 		for(long j=1;j<nx-1;j++)	b[j+k] = (a[j+k+1]-a[j+k-1])*dd;
441 	}
442 	return 0;
443 }
mgl_datac_diff(HADT d,const char * dir)444 void MGL_EXPORT mgl_datac_diff(HADT d, const char *dir)
445 {
446 	if(!dir || *dir==0)	return;
447 	long nx=d->nx,ny=d->ny,nz=d->nz,nn=nx*ny*nz;
448 	long p[3]={nx,ny,nz};
449 	dual *b = new dual[nn];
450 	if(strchr(dir,'z') && nz>1)
451 	{
452 		mglStartThreadC(mgl_cdif_z,0,nx*ny,b,d->a,0,p);
453 		memcpy(d->a,b,nn*sizeof(dual));
454 	}
455 	if(strchr(dir,'y') && ny>1)
456 	{
457 		mglStartThreadC(mgl_cdif_y,0,nx*nz,b,d->a,0,p);
458 		memcpy(d->a,b,nn*sizeof(dual));
459 	}
460 	if(strchr(dir,'x') && nx>1)
461 	{
462 		mglStartThreadC(mgl_cdif_x,0,nz*ny,b,d->a,0,p);
463 		memcpy(d->a,b,nn*sizeof(dual));
464 	}
465 	delete []b;
466 }
mgl_datac_diff_(uintptr_t * d,const char * dir,int l)467 void MGL_EXPORT mgl_datac_diff_(uintptr_t *d, const char *dir,int l)
468 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
469 	mgl_datac_diff(_DC_,s);	delete []s;	}
470 //-----------------------------------------------------------------------------
mgl_cdif2_z(void * par)471 static void *mgl_cdif2_z(void *par)
472 {
473 	mglThreadC *t=(mglThreadC *)par;
474 	long nz=t->p[2], nn=t->n;
475 	dual *b=t->a, dd=0.5*nz*nz;
476 	const dual *a=t->b;
477 #if !MGL_HAVE_PTHREAD
478 #pragma omp parallel for
479 #endif
480 	for(long i=t->id;i<nn;i+=mglNumThr)
481 	{
482 		b[i] = b[i+(nz-1)*nn] = 0;
483 		for(long j=1;j<nz-1;j++)		b[i+j*nn] = (a[i+j*nn+nn]+a[i+j*nn-nn]-mgl2*a[i+j*nn])*dd;
484 	}
485 	return 0;
486 }
mgl_cdif2_y(void * par)487 static void *mgl_cdif2_y(void *par)
488 {
489 	mglThreadC *t=(mglThreadC *)par;
490 	long nx=t->p[0], ny=t->p[1], nn=t->n;
491 	dual *b=t->a, dd=0.5*ny*ny;
492 	const dual *a=t->b;
493 #if !MGL_HAVE_PTHREAD
494 #pragma omp parallel for
495 #endif
496 	for(long i=t->id;i<nn;i+=mglNumThr)
497 	{
498 		long k = (i%nx)+nx*ny*(i/nx);	b[k] = b[k+(ny-1)*nx] = 0;
499 		for(long j=1;j<ny-1;j++)	b[k+j*nx] = (a[k+j*nx+nx]+a[k+j*nx-nx]-mgl2*a[k+j*nx])*dd;
500 	}
501 	return 0;
502 }
mgl_cdif2_x(void * par)503 static void *mgl_cdif2_x(void *par)
504 {
505 	mglThreadC *t=(mglThreadC *)par;
506 	long nx=t->p[0], nn=t->n;
507 	dual *b=t->a, dd=0.5*nx*nx;
508 	const dual *a=t->b;
509 #if !MGL_HAVE_PTHREAD
510 #pragma omp parallel for
511 #endif
512 	for(long i=t->id;i<nn;i+=mglNumThr)
513 	{
514 		long k = i*nx;			b[k] = b[k+nx-1] = 0;
515 		for(long j=1;j<nx-1;j++)	b[j+k] = (a[j+k+1]+a[j+k-1]-mgl2*a[j+k])*dd;
516 	}
517 	return 0;
518 }
mgl_datac_diff2(HADT d,const char * dir)519 void MGL_EXPORT mgl_datac_diff2(HADT d, const char *dir)
520 {
521 	if(!dir || *dir==0)	return;
522 	long nx=d->nx,ny=d->ny,nz=d->nz,nn=nx*ny*nz;
523 	long p[3]={nx,ny,nz};
524 	dual *b = new dual[nn];
525 	if(strchr(dir,'z') && nz>1)
526 	{
527 		mglStartThreadC(mgl_cdif2_z,0,nx*ny,b,d->a,0,p);
528 		memcpy(d->a,b,nn*sizeof(dual));
529 	}
530 	if(strchr(dir,'y') && ny>1)
531 	{
532 		mglStartThreadC(mgl_cdif2_y,0,nx*nz,b,d->a,0,p);
533 		memcpy(d->a,b,nn*sizeof(dual));
534 	}
535 	if(strchr(dir,'x') && nx>1)
536 	{
537 		mglStartThreadC(mgl_cdif2_x,0,nz*ny,b,d->a,0,p);
538 		memcpy(d->a,b,nn*sizeof(dual));
539 	}
540 	delete []b;
541 }
mgl_datac_diff2_(uintptr_t * d,const char * dir,int l)542 void MGL_EXPORT mgl_datac_diff2_(uintptr_t *d, const char *dir,int l)
543 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
544 	mgl_datac_diff2(_DC_,s);	delete []s;	}
545 //-----------------------------------------------------------------------------
mgl_datac_swap(HADT d,const char * dir)546 void MGL_EXPORT mgl_datac_swap(HADT d, const char *dir)
547 {
548 	if(!dir || *dir==0)	return;
549 	if(strchr(dir,'z') && d->nz>1)	mgl_datac_roll(d,'z',d->nz/2);
550 	if(strchr(dir,'y') && d->ny>1)	mgl_datac_roll(d,'y',d->ny/2);
551 	if(strchr(dir,'x') && d->nx>1)	mgl_datac_roll(d,'x',d->nx/2);
552 }
mgl_datac_swap_(uintptr_t * d,const char * dir,int l)553 void MGL_EXPORT mgl_datac_swap_(uintptr_t *d, const char *dir,int l)
554 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
555 	mgl_datac_swap(_DC_,s);	delete []s;	}
556 //-----------------------------------------------------------------------------
mgl_datac_roll(HADT dd,char dir,long num)557 void MGL_EXPORT mgl_datac_roll(HADT dd, char dir, long num)
558 {
559 	long nx=dd->nx,ny=dd->ny,nz=dd->nz, d;
560 	dual *b,*a=dd->a;
561 	if(dir=='z' && nz>1)
562 	{
563 		d = num>0 ? num%nz : (num+nz*(1-num/nz))%nz;
564 		if(d==0)	return;		// nothing to do
565 		b = new dual[nx*ny*nz];
566 		memcpy(b,a+nx*ny*d,nx*ny*(nz-d)*sizeof(dual));
567 		memcpy(b+nx*ny*(nz-d),a,nx*ny*d*sizeof(dual));
568 		memcpy(a,b,nx*ny*nz*sizeof(dual));	delete []b;
569 	}
570 	if(dir=='y' && ny>1)
571 	{
572 		d = num>0 ? num%ny : (num+ny*(1-num/ny))%ny;
573 		if(d==0)	return;		// nothing to do
574 		b = new dual[nx*ny*nz];
575 		memcpy(b,a+nx*d,(nx*ny*nz-nx*d)*sizeof(dual));
576 #pragma omp parallel for
577 		for(long i=0;i<nz;i++)
578 			memcpy(b+nx*(ny-d)+nx*ny*i,a+nx*ny*i,nx*d*sizeof(dual));
579 		memcpy(a,b,nx*ny*nz*sizeof(dual));	delete []b;
580 	}
581 	if(dir=='x' && nx>1)
582 	{
583 		d = num>0 ? num%nx : (num+nx*(1-num/nx))%nx;
584 		if(d==0)	return;		// nothing to do
585 		b = new dual[nx*ny*nz];
586 		memcpy(b,a+d,(nx*ny*nz-d)*sizeof(dual));
587 #pragma omp parallel for
588 		for(long i=0;i<nz*ny;i++)
589 			memcpy(b+nx-d+nx*i,a+nx*i,d*sizeof(dual));
590 		memcpy(a,b,nx*ny*nz*sizeof(dual));	delete []b;
591 	}
592 }
mgl_datac_roll_(uintptr_t * d,const char * dir,int * num,int)593 void MGL_EXPORT mgl_datac_roll_(uintptr_t *d, const char *dir, int *num, int)
594 {	mgl_datac_roll(_DC_,*dir,*num);	}
595 //-----------------------------------------------------------------------------
mgl_datac_mirror(HADT d,const char * dir)596 void MGL_EXPORT mgl_datac_mirror(HADT d, const char *dir)
597 {
598 	if(!dir || *dir==0)	return;
599 	long nx=d->nx,ny=d->ny,nz=d->nz;
600 	dual *a=d->a;
601 	if(strchr(dir,'z') && nz>1)
602 	{
603 #pragma omp parallel for collapse(2)
604 		for(long j=0;j<nz/2;j++)	for(long i=0;i<nx*ny;i++)
605 		{
606 			long i0 = i+j*nx*ny, j0 = i+(nz-1-j)*nx*ny;
607 			dual b = a[i0];	a[i0] = a[j0];	a[j0] = b;
608 		}
609 	}
610 	if(strchr(dir,'y') && ny>1)
611 	{
612 #pragma omp parallel for collapse(2)
613 		for(long j=0;j<ny/2;j++)	for(long i=0;i<nx*nz;i++)
614 		{
615 			long j0 = (i%nx)+nx*(ny*(i/nx)+j), i0 = j0+(ny-1-2*j)*nx;
616 			dual b = a[j0];	a[j0] = a[i0];	a[i0] = b;
617 		}
618 	}
619 	if(strchr(dir,'x') && nx>1)
620 	{
621 #pragma omp parallel for collapse(2)
622 		for(long j=0;j<ny*nz;j++)	for(long i=0;i<nx/2;i++)
623 		{
624 			long i0 = nx-1-i+j*nx, j0 = i+j*nx;
625 			dual b = a[j0];	a[j0] = a[i0];	a[i0] = b;
626 		}
627 	}
628 }
mgl_datac_mirror_(uintptr_t * d,const char * dir,int l)629 void MGL_EXPORT mgl_datac_mirror_(uintptr_t *d, const char *dir,int l)
630 {	char *s=new char[l+1];	memcpy(s,dir,l);	s[l]=0;
631 	mgl_datac_mirror(_DC_,s);	delete []s;	}
632 //-----------------------------------------------------------------------------
mglSpline3Cs(const dual * a,long nx,long ny,long nz,mreal x,mreal y,mreal z)633 dual MGL_EXPORT mglSpline3Cs(const dual *a, long nx, long ny, long nz, mreal x, mreal y, mreal z)
634 {	return mglSpline3st<dual>(a,nx,ny,nz,x,y,z);	}
635 //-----------------------------------------------------------------------------
mglSpline3C(const dual * a,long nx,long ny,long nz,mreal x,mreal y,mreal z,dual * dx,dual * dy,dual * dz)636 dual MGL_EXPORT mglSpline3C(const dual *a, long nx, long ny, long nz, mreal x, mreal y, mreal z,dual *dx, dual *dy, dual *dz)
637 {	return mglSpline3t<dual>(a,nx,ny,nz,x,y,z,dx,dy,dz);	}
638 //-----------------------------------------------------------------------------
mglLinearC(const dual * a,long nx,long ny,long nz,mreal x,mreal y,mreal z)639 dual MGL_EXPORT mglLinearC(const dual *a, long nx, long ny, long nz, mreal x, mreal y, mreal z)
640 {	return mglLineart<dual>(a,nx,ny,nz,x,y,z);	}
641 //-----------------------------------------------------------------------------
mgl_datac_spline(HCDT d,mreal x,mreal y,mreal z)642 cmdual MGL_EXPORT mgl_datac_spline(HCDT d, mreal x,mreal y,mreal z)
643 {
644 	const mglDataC *dd=dynamic_cast<const mglDataC *>(d);
645 	return mdual(dd ? mglSpline3st<dual>(dd->a,dd->nx,dd->ny,dd->nz,x,y,z) : d->value(x,y,z));
646 }
647 //-----------------------------------------------------------------------------
mgl_datac_spline_ext(HCDT d,mreal x,mreal y,mreal z,mdual * dx,mdual * dy,mdual * dz)648 cmdual MGL_EXPORT mgl_datac_spline_ext(HCDT d, mreal x,mreal y,mreal z, mdual *dx,mdual *dy,mdual *dz)
649 {
650 	const mglDataC *dd=dynamic_cast<const mglDataC *>(d);
651 	if(!dd)
652 	{
653 		mreal rx=0,ry=0,rz=0,res;
654 		res=d->valueD(x,y,z,&rx,&ry,&rz);
655 		if(dx)	*dx=rx;
656 		if(dy)	*dy=ry;
657 		if(dz)	*dz=rz;
658 		return mdual(res);
659 	}
660 	dual xx,yy,zz, res = mglSpline3t<dual>(dd->a,dd->nx,dd->ny,dd->nz,x,y,z,&xx,&yy,&zz);
661 	if(dx)	*dx=xx;
662 	if(dy)	*dy=yy;
663 	if(dz)	*dz=zz;
664 	return mdual(res);
665 }
666 //-----------------------------------------------------------------------------
mgl_datac_spline_(uintptr_t * d,mreal * x,mreal * y,mreal * z)667 cmdual MGL_EXPORT mgl_datac_spline_(uintptr_t *d, mreal *x,mreal *y,mreal *z)
668 {	return mgl_datac_spline(_DA_(d),*x,*y,*z);	}
mgl_datac_spline_ext_(uintptr_t * d,mreal * x,mreal * y,mreal * z,mdual * dx,mdual * dy,mdual * dz)669 cmdual MGL_EXPORT mgl_datac_spline_ext_(uintptr_t *d, mreal *x,mreal *y,mreal *z, mdual *dx,mdual *dy,mdual *dz)
670 {	return mgl_datac_spline_ext(_DA_(d),*x,*y,*z,dx,dy,dz);	}
671 //-----------------------------------------------------------------------------
mgl_datac_linear_ext(HCDT d,mreal x,mreal y,mreal z,mdual * dx,mdual * dy,mdual * dz)672 cmdual MGL_EXPORT mgl_datac_linear_ext(HCDT d, mreal x,mreal y,mreal z, mdual *dx,mdual *dy,mdual *dz)
673 {
674 	long kx=long(x), ky=long(y), kz=long(z);
675 	dual b0,b1;
676 	const mglDataC *dd=dynamic_cast<const mglDataC *>(d);
677 	if(!dd)
678 	{
679 		mreal rx=0,ry=0,rz=0,res;
680 		res=mgl_data_linear_ext(d,x,y,z,&rx,&ry,&rz);
681 		if(dx)	*dx=rx;
682 		if(dy)	*dy=ry;
683 		if(dz)	*dz=rz;
684 		return mdual(res);
685 	}
686 
687 	long nx=dd->nx, ny=dd->ny, nz=dd->nz, dn=ny>1?nx:0;
688 	kx = kx>=0 ? kx:0;	kx = kx<nx-1 ? kx:nx-2;
689 	ky = ky>=0 ? ky:0;	ky = ky<ny-1 ? ky:ny-2;
690 	kz = kz>=0 ? kz:0;	kz = kz<nz-1 ? kz:nz-2;
691 	x -= kx;	y -= ky;	z -= kz;
692 	const dual *aa = dd->a, *bb;
693 	if(kz>=0)
694 	{
695 		aa=dd->a+kx+nx*(ky+ny*kz);	bb = aa+nx*ny;
696 		b0 = aa[0]*(1-x-y+x*y) + x*(1-y)*aa[1] + y*(1-x)*aa[dn] + x*y*aa[1+dn];
697 		b1 = bb[0]*(1-x-y+x*y) + x*(1-y)*bb[1] + y*(1-x)*bb[dn] + x*y*bb[1+dn];
698 	}
699 	else
700 	{
701 		z=0;
702 		if(ky>=0)
703 		{
704 			aa=dd->a+kx+nx*ky;
705 			b0 = b1 = aa[0]*(1-x-y+x*y) + x*(1-y)*aa[1] + y*(1-x)*aa[dn] + x*y*aa[1+dn];
706 		}
707 		else if(kx>=0)
708 		{
709 			aa=dd->a+kx;	b0 = b1 = aa[0]*(1-x) + x*aa[1];
710 		}
711 		else	b0 = b1 = dd->a[0];
712 	}
713 	if(dx)	*dx = kx>=0?aa[1]-aa[0]:0;
714 	if(dy)	*dy = ky>=0?aa[dn]-aa[0]:0;
715 	if(dz)	*dz = b1-b0;
716 	return mdual(b0 + z*(b1-b0));
717 }
mgl_datac_linear(HCDT d,mreal x,mreal y,mreal z)718 cmdual MGL_EXPORT mgl_datac_linear(HCDT d, mreal x,mreal y,mreal z)
719 {	return mgl_datac_linear_ext(d, x,y,z, 0,0,0);	}
720 //-----------------------------------------------------------------------------
mgl_datac_linear_(uintptr_t * d,mreal * x,mreal * y,mreal * z)721 cmdual MGL_EXPORT mgl_datac_linear_(uintptr_t *d, mreal *x,mreal *y,mreal *z)
722 {	return mgl_datac_linear(_DA_(d),*x,*y,*z);	}
mgl_datac_linear_ext_(uintptr_t * d,mreal * x,mreal * y,mreal * z,mdual * dx,mdual * dy,mdual * dz)723 cmdual MGL_EXPORT mgl_datac_linear_ext_(uintptr_t *d, mreal *x,mreal *y,mreal *z, mdual *dx,mdual *dy,mdual *dz)
724 {	return mgl_datac_linear_ext(_DA_(d),*x,*y,*z,dx,dy,dz);	}
725 //-----------------------------------------------------------------------------
726 long MGL_NO_EXPORT mgl_powers(long N, const char *how);
mgl_datac_crop_opt(HADT d,const char * how)727 void MGL_EXPORT mgl_datac_crop_opt(HADT d, const char *how)
728 {
729 	const char *h = "235";
730 	if(mglchr(how,'2') || mglchr(how,'3') || mglchr(how,'5'))	h = how;
731 	if(mglchr(how,'x'))	mgl_datac_crop(d, 0, mgl_powers(d->nx, h), 'x');
732 	if(mglchr(how,'y'))	mgl_datac_crop(d, 0, mgl_powers(d->ny, h), 'y');
733 	if(mglchr(how,'z'))	mgl_datac_crop(d, 0, mgl_powers(d->nz, h), 'z');
734 }
mgl_datac_crop_opt_(uintptr_t * d,const char * how,int l)735 void MGL_EXPORT mgl_datac_crop_opt_(uintptr_t *d, const char *how, int l)
736 {	char *s=new char[l+1];	memcpy(s,how,l);	s[l]=0;
737 	mgl_datac_crop_opt(_DC_,s);	delete []s;	}
738 //-----------------------------------------------------------------------------
mgl_datac_crop(HADT d,long n1,long n2,char dir)739 void MGL_EXPORT mgl_datac_crop(HADT d, long n1, long n2, char dir)
740 {
741 	long nx=d->nx,ny=d->ny,nz=d->nz, nn;
742 	dual *b;
743 	if(n1<0)	n1=0;
744 	switch(dir)
745 	{
746 	case 'x':
747 		if(n1>=nx)	break;
748 		n2 = n2>0 ? n2 : nx+n2;
749 		if(n2<0 || n2>=nx || n2<n1)	n2 = nx;
750 		nn = n2-n1;	b = new dual[nn*ny*nz];
751 #pragma omp parallel for
752 		for(long i=0;i<ny*nz;i++)
753 			memcpy(b+nn*i,d->a+nx*i+n1,nn*sizeof(dual));
754 		d->nx = nn;	if(!d->link)	delete []d->a;
755 		d->a = b;	d->link=false;	d->NewId();
756 		break;
757 	case 'y':
758 		if(n1>=ny)	break;
759 		n2 = n2>0 ? n2 : ny+n2;
760 		if(n2<0 || n2>=ny || n2<n1)	n2 = ny;
761 		nn = n2-n1;	b = new dual[nn*nx*nz];
762 #pragma omp parallel for
763 		for(long j=0;j<nz;j++)	for(long i=0;i<nn;i++)
764 			memcpy(b+nx*(i+nn*j),d->a+nx*(n1+i+ny*j),nx*sizeof(dual));
765 		d->ny = nn;	if(!d->link)	delete []d->a;
766 		d->a = b;	d->link=false;
767 		break;
768 	case 'z':
769 		if(n1>=nz)	break;
770 		n2 = n2>0 ? n2 : nz+n2;
771 		if(n2<0 || n2>=nz || n2<n1)	n2 = nz;
772 		nn = n2-n1;	b = new dual[nn*nx*ny];
773 		memcpy(b,d->a+nx*ny*n1,nn*nx*ny*sizeof(dual));
774 		d->nz = nn;	if(!d->link)	delete []d->a;
775 		d->a = b;	d->link=false;
776 		break;
777 	}
778 }
mgl_datac_crop_(uintptr_t * d,int * n1,int * n2,const char * dir,int)779 void MGL_EXPORT mgl_datac_crop_(uintptr_t *d, int *n1, int *n2, const char *dir,int)
780 {	mgl_datac_crop(_DC_,*n1,*n2,*dir);	}
781 //-----------------------------------------------------------------------------
mgl_datac_insert(HADT d,char dir,long at,long num)782 void MGL_EXPORT mgl_datac_insert(HADT d, char dir, long at, long num)
783 {
784 	if(num<1)	return;
785 	at = at<0 ? 0:at;
786 	long nx=d->nx, ny=d->ny, nz=d->nz, nn;
787 	mglDataC b;
788 	if(dir=='x')
789 	{
790 		if(at>nx)	at=nx;
791 		nn=nx+num;	b.Create(nn,ny,nz);
792 #pragma omp parallel for
793 		for(long k=0;k<ny*nz;k++)
794 		{
795 			if(at>0)	memcpy(b.a+nn*k, d->a+nx*k,at*sizeof(dual));
796 			if(at<nx)	memcpy(b.a+at+num+nn*k, d->a+at+nx*k,(nx-at)*sizeof(dual));
797 			for(long i=0;i<num;i++)	b.a[nn*k+at+i]=d->a[nx*k+at];	// copy values
798 		}
799 		d->Set(b);	nx+=num;
800 	}
801 	if(dir=='y')
802 	{
803 		if(at>ny)	at=ny;
804 		nn=num+ny;	b.Create(nx,nn,nz);
805 #pragma omp parallel for
806 		for(long k=0;k<nz;k++)
807 		{
808 			if(at>0)	memcpy(b.a+nx*nn*k, d->a+nx*ny*k,at*nx*sizeof(dual));
809 			if(at<ny)	memcpy(b.a+nx*(at+num+nn*k), d->a+nx*(at+ny*k),(ny-at)*nx*sizeof(dual));
810 			for(long i=0;i<num;i++)	memcpy(b.a+nx*(nn*k+at+i),d->a+nx*(ny*k+at),nx*sizeof(dual));
811 		}
812 		d->Set(b);	ny+=num;
813 	}
814 	if(dir=='z')
815 	{
816 		if(at>nz)	at=nz;
817 		b.Create(nx,ny,nz+num);
818 		if(at>0)	memcpy(b.a, d->a,at*nx*ny*sizeof(dual));
819 		if(at<nz)	memcpy(b.a+nx*ny*(at+num), d->a+nx*ny*at,(nz-at)*nx*ny*sizeof(dual));
820 #pragma omp parallel for
821 		for(long i=0;i<num;i++)	memcpy(b.a+nx*ny*(at+i),d->a+nx*ny*at,nx*ny*sizeof(dual));
822 		d->Set(b);
823 	}
824 }
825 //-----------------------------------------------------------------------------
mgl_datac_delete(HADT d,char dir,long at,long num)826 void MGL_EXPORT mgl_datac_delete(HADT d, char dir, long at, long num)
827 {
828 	if(num<1 || at<0)	return;
829 	mglDataC b;
830 	long nx=d->nx, ny=d->ny, nz=d->nz, nn;
831 	if(dir=='x')
832 	{
833 		if(at+num>=nx)	return;
834 		nn=nx-num;	b.Create(nn,ny,nz);
835 #pragma omp parallel for
836 		for(long k=0;k<ny*nz;k++)
837 		{
838 			if(at>0)	memcpy(b.a+nn*k, d->a+nx*k,at*sizeof(dual));
839 			memcpy(b.a+at+nn*k, d->a+at+num+nx*k,(nx-at-num)*sizeof(dual));
840 		}
841 		d->Set(b);	nx-=num;
842 	}
843 	if(dir=='y')
844 	{
845 		if(at+num>=ny)	return;
846 		nn=ny-num;	b.Create(nx,nn,nz);
847 #pragma omp parallel for
848 		for(long k=0;k<nz;k++)
849 		{
850 			if(at>0)	memcpy(b.a+nx*nn*k, d->a+nx*ny*k,at*nx*sizeof(dual));
851 			memcpy(b.a+nx*(at+nn*k), d->a+nx*(at+num+ny*k),(ny-at-num)*nx*sizeof(dual));
852 		}
853 		d->Set(b);	ny-=num;
854 	}
855 	if(dir=='z')
856 	{
857 		if(at+num>=nz)	return;
858 		b.Create(nx,ny,nz-num);
859 		if(at>0)	memcpy(b.a, d->a,at*nx*ny*sizeof(dual));
860 		memcpy(b.a+nx*ny*at, d->a+nx*ny*(at+num),(nz-at-num)*nx*ny*sizeof(dual));
861 		d->Set(b);
862 	}
863 }
864 //-----------------------------------------------------------------------------
mgl_datac_insert_(uintptr_t * d,const char * dir,int * at,int * num,int)865 void MGL_EXPORT mgl_datac_insert_(uintptr_t *d, const char *dir, int *at, int *num, int)
866 {	mgl_datac_insert(_DC_,*dir,*at,*num);	}
mgl_datac_delete_(uintptr_t * d,const char * dir,int * at,int * num,int)867 void MGL_EXPORT mgl_datac_delete_(uintptr_t *d, const char *dir, int *at, int *num, int)
868 {	mgl_datac_delete(_DC_,*dir,*at,*num);	}
869 //-----------------------------------------------------------------------------
mgl_datac_set_value(HADT dat,mdual v,long i,long j,long k)870 void MGL_EXPORT mgl_datac_set_value(HADT dat, mdual v, long i, long j, long k)
871 {
872 	if(i>=0 && i<dat->nx && j>=0 && j<dat->ny && k>=0 && k<dat->nz)
873 		dat->a[i+dat->nx*(j+dat->ny*k)]=v;
874 }
mgl_datac_set_value_(uintptr_t * d,mdual * v,int * i,int * j,int * k)875 void MGL_EXPORT mgl_datac_set_value_(uintptr_t *d, mdual *v, int *i, int *j, int *k)
876 {	mgl_datac_set_value(_DC_,*v,*i,*j,*k);	}
877 //-----------------------------------------------------------------------------
mgl_datac_get_value(HCDT dat,long i,long j,long k)878 cmdual MGL_EXPORT mgl_datac_get_value(HCDT dat, long i, long j, long k)
879 {
880 	long nx=dat->GetNx(), ny=dat->GetNy(), i0=i+nx*(j+ny*k);
881 	if(i<0 || i>=nx || j<0 || j>=ny || k<0 || k>=dat->GetNz())
882 		return mdual(NAN);
883 	const mglDataC *d = dynamic_cast<const mglDataC*>(dat);
884 	return mdual(d ? d->a[i0] : dual(dat->vthr(i0),0));
885 }
mgl_datac_get_value_(uintptr_t * d,int * i,int * j,int * k)886 cmdual MGL_EXPORT mgl_datac_get_value_(uintptr_t *d, int *i, int *j, int *k)
887 {	return mgl_datac_get_value(_DA_(d),*i,*j,*k);	}
888 //-----------------------------------------------------------------------------
mgl_datac_data(HADT dat)889 MGL_EXPORT_PURE mdual *mgl_datac_data(HADT dat)
890 {	return reinterpret_cast<mdual*>(dat->a);	}
891 //-----------------------------------------------------------------------------
mgl_datac_value(HADT dat,long i,long j,long k)892 MGL_EXPORT mdual *mgl_datac_value(HADT dat, long i,long j,long k)
893 {	long ii=i*dat->nx*(j+dat->ny*k);
894 	return	ii>=0 && ii<dat->GetNN() ? reinterpret_cast<mdual*>(dat->a+ii) : 0;	}
895 //-----------------------------------------------------------------------------
mgl_datac_join(HADT d,HCDT v)896 void MGL_EXPORT mgl_datac_join(HADT d, HCDT v)
897 {
898 	long nx=d->nx, ny=d->ny, nz=d->nz, k=nx*ny*nz;
899 	const mglDataC *mv = dynamic_cast<const mglDataC *>(v);
900 	long vx=v->GetNx(), vy=v->GetNy(), vz=v->GetNz(), m = vx*vy*vz;
901 
902 	if(nx==vx && ny==vy && ny>1)	d->nz += vz;
903 	else
904 	{
905 		ny *= nz;	vy *= vz;
906 		if(nx==vx && nx>1)
907 		{	d->nz = 1;	d->ny = ny+vy;	}
908 		else
909 		{	d->ny = d->nz = 1;	d->nx = k+m;	}
910 	}
911 	dual *b = new dual[k+m];
912 	memcpy(b,d->a,k*sizeof(dual));
913 	if(mv)	memcpy(b+k,mv->a,m*sizeof(dual));
914 	else
915 #pragma omp parallel for
916 		for(long i=0;i<m;i++)	b[k+i] = v->vthr(i);
917 	if(!d->link)	delete []d->a;
918 	d->a = b;	d->link=false;	d->NewId();
919 }
920 //-----------------------------------------------------------------------------
mgl_datac_join_(uintptr_t * d,uintptr_t * val)921 void MGL_EXPORT mgl_datac_join_(uintptr_t *d, uintptr_t *val)
922 {	mgl_datac_join(_DC_,_DA_(val));	}
923 //-----------------------------------------------------------------------------
mgl_datac_put_val(HADT d,mdual val,long xx,long yy,long zz)924 void MGL_EXPORT mgl_datac_put_val(HADT d, mdual val, long xx, long yy, long zz)
925 {
926 	long nx=d->nx, ny=d->ny, nz=d->nz;
927 	if(xx>=nx || yy>=ny || zz>=nz)	return;
928 	dual *a=d->a;
929 	if(xx>=0 && yy>=0 && zz>=0)	a[xx+nx*(yy+zz*ny)] = val;
930 	else if(xx<0 && yy<0 && zz<0)
931 #pragma omp parallel for
932 		for(long i=0;i<nx*ny*nz;i++)	a[i] = val;
933 	else if(xx<0 && yy<0)
934 #pragma omp parallel for
935 		for(long i=0;i<nx*ny;i++)	a[i+zz*nx*ny] = val;
936 	else if(yy<0 && zz<0)
937 #pragma omp parallel for
938 		for(long i=0;i<nz*ny;i++)	a[xx+i*nx] = val;
939 	else if(xx<0 && zz<0)
940 #pragma omp parallel for collapse(2)
941 		for(long j=0;j<nz;j++)	for(long i=0;i<nx;i++)	a[i+nx*(yy+j*ny)] = val;
942 	else if(xx<0)
943 #pragma omp parallel for
944 		for(long i=0;i<nx;i++)	a[i+nx*(yy+zz*ny)] = val;
945 	else if(yy<0)
946 #pragma omp parallel for
947 		for(long i=0;i<ny;i++)	a[xx+nx*(i+zz*ny)] = val;
948 	else //if(zz<0)
949 #pragma omp parallel for
950 		for(long i=0;i<nz;i++)	a[xx+nx*(yy+i*ny)] = val;
951 }
952 //-----------------------------------------------------------------------------
mgl_datac_put_dat(HADT d,HCDT v,long xx,long yy,long zz)953 void MGL_EXPORT mgl_datac_put_dat(HADT d, HCDT v, long xx, long yy, long zz)
954 {
955 	long nx=d->nx, ny=d->ny, nz=d->nz;
956 	if(xx>=nx || yy>=ny || zz>=nz)	return;
957 	const mglDataC *mv = dynamic_cast<const mglDataC *>(v);
958 	dual *a=d->a, vv=v->v(0);
959 	const dual *b = mv?mv->a:0;
960 	long vx=v->GetNx(), vy=v->GetNy(), vz=v->GetNz();
961 	if(xx<0 && yy<0 && zz<0)	// whole array
962 	{
963 		if(vx>=nx && vy>=ny && vz>=nz)
964 #pragma omp parallel for
965 			for(long ii=0;ii<nx*ny*nz;ii++)
966 			{	long i=ii%nx, j=(ii/nx)%ny, k=ii/(nx*ny);
967 				a[ii] = b?b[i+vx*(j+k*vy)]:v->v(i,j,k);	}
968 		else if(vx>=nx && vy>=ny)
969 #pragma omp parallel for
970 			for(long ii=0;ii<nx*ny*nz;ii++)
971 			{	long i=ii%nx, j=(ii/nx)%ny;
972 				a[ii] = b?b[i+vx*j]:v->v(i,j);	}
973 		else if(vx>=nx)
974 #pragma omp parallel for
975 			for(long ii=0;ii<nx*ny*nz;ii++)
976 			{	long i=ii%nx;	a[ii] = b?b[i]:v->v(i);	}
977 		else
978 #pragma omp parallel for
979 			for(long ii=0;ii<nx*ny*nz;ii++)	a[ii] = vv;
980 	}
981 	else if(xx<0 && yy<0)	// 2d
982 	{
983 		zz*=nx*ny;
984 		if(vx>=nx && vy>=ny)
985 #pragma omp parallel for
986 			for(long ii=0;ii<nx*ny;ii++)
987 			{	long i=ii%nx, j=ii/nx;
988 				a[ii+zz] = b?b[i+vx*j]:v->v(i,j);	}
989 		else if(vx>=nx)
990 #pragma omp parallel for
991 			for(long ii=0;ii<nx*ny;ii++)
992 			{	long i=ii%nx;	a[ii+zz] = b?b[i]:v->v(i);	}
993 		else
994 #pragma omp parallel for
995 			for(long ii=0;ii<nx*ny;ii++) 	a[ii+zz] = vv;
996 	}
997 	else if(yy<0 && zz<0)	// 2d
998 	{
999 		if(vx>=ny && vy>=nz)
1000 #pragma omp parallel for
1001 			for(long ii=0;ii<ny*nz;ii++)
1002 			{	long i=ii%ny, j=ii/ny;
1003 				a[ii*nx+xx] = b?b[i+vx*j]:v->v(i,j);	}
1004 		else if(vx>=ny)
1005 #pragma omp parallel for
1006 			for(long ii=0;ii<ny*nz;ii++)
1007 			{	long i=ii%ny;	a[ii*nx+xx] = b?b[i]:v->v(i);	}
1008 		else
1009 #pragma omp parallel for
1010 			for(long ii=0;ii<ny*nz;ii++) 	a[ii*nx+xx] = vv;
1011 	}
1012 	else if(xx<0 && zz<0)	// 2d
1013 	{
1014 		yy *= nx;	zz = nx*ny;
1015 		if(vx>=nx && vy>=nz)
1016 #pragma omp parallel for
1017 			for(long ii=0;ii<nx*nz;ii++)
1018 			{	long i=ii%nx, j=ii/nx;
1019 				a[i+yy+j*zz] = b?b[i+vx*j]:v->v(i,j);	}
1020 		else if(vx>=nx)
1021 #pragma omp parallel for
1022 			for(long ii=0;ii<nx*nz;ii++)
1023 			{	long i=ii%nx, j=ii/nx;
1024 				a[i+yy+j*zz] = b?b[i]:v->v(i);	}
1025 		else
1026 #pragma omp parallel for
1027 			for(long ii=0;ii<nx*nz;ii++)
1028 			{	long i=ii%nx, j=ii/nx;
1029 				a[i+yy+j*zz] = vv;	}
1030 	}
1031 	else if(xx<0)
1032 	{
1033 		xx = nx*(yy+zz*ny);
1034 		if(vx>=nx)
1035 #pragma omp parallel for
1036 			for(long i=0;i<nx;i++)	a[i+xx] = b?b[i]:v->v(i);
1037 		else
1038 #pragma omp parallel for
1039 			for(long i=0;i<nx;i++)	a[i+xx] = vv;
1040 	}
1041 	else if(yy<0)
1042 	{
1043 		xx += zz*nx*ny;
1044 		if(vx>=ny)
1045 #pragma omp parallel for
1046 			for(long i=0;i<ny;i++)	a[xx+nx*i] = b?b[i]:v->v(i);
1047 		else
1048 #pragma omp parallel for
1049 			for(long i=0;i<ny;i++)	a[xx+nx*i] = vv;
1050 	}
1051 	else if(zz<0)
1052 	{
1053 		xx += nx*yy;	yy = nx*ny;
1054 		if(vx>=nz)
1055 #pragma omp parallel for
1056 			for(long i=0;i<nz;i++)	a[xx+yy*i] = b?b[i]:v->v(i);
1057 		else
1058 #pragma omp parallel for
1059 			for(long i=0;i<nz;i++)	a[xx+yy*i] = vv;
1060 	}
1061 	else	a[xx+nx*(yy+ny*zz)] = vv;
1062 }
1063 //-----------------------------------------------------------------------------
mgl_datac_put_val_(uintptr_t * d,mdual * val,int * i,int * j,int * k)1064 void MGL_EXPORT mgl_datac_put_val_(uintptr_t *d, mdual *val, int *i, int *j, int *k)
1065 {	mgl_datac_put_val(_DC_,*val, *i,*j,*k);	}
mgl_datac_put_dat_(uintptr_t * d,uintptr_t * val,int * i,int * j,int * k)1066 void MGL_EXPORT mgl_datac_put_dat_(uintptr_t *d, uintptr_t *val, int *i, int *j, int *k)
1067 {	mgl_datac_put_dat(_DC_,_DA_(val), *i,*j,*k);	}
1068 //-----------------------------------------------------------------------------
1069 void MGL_EXPORT mgl_difr_grid(dual *a,int n,int step,dual q,int Border,dual *tmp,int kk);
1070 void MGL_EXPORT mgl_difr_axial(dual *a,int n,int step,dual q,int Border,dual *tmp,int kk, double di);
1071 //-----------------------------------------------------------------------------
mgl_difr(void * par)1072 static void *mgl_difr(void *par)
1073 {
1074 #if !defined(_MSC_VER)	// MSVC produce internal compiler error on this code
1075 	mglThreadC *t=(mglThreadC *)par;
1076 	long n=t->p[0], st=t->p[1], bord=t->p[3], nn=t->n;
1077 	dual *b=t->a, q = *(t->b);
1078 #if !MGL_HAVE_PTHREAD
1079 #pragma omp parallel
1080 #endif
1081 	{
1082 		dual *tmp = new dual[2*n];
1083 		if(t->p[2])
1084 #if !MGL_HAVE_PTHREAD
1085 #pragma omp for
1086 #endif
1087 			for(long i=t->id;i<nn;i+=mglNumThr)
1088 				mgl_difr_axial(b + ((i%st)+n*(i/st)), n,st, q, bord,tmp,3,0);
1089 		else
1090 #if !MGL_HAVE_PTHREAD
1091 #pragma omp for
1092 #endif
1093 			for(long i=t->id;i<nn;i+=mglNumThr)
1094 				mgl_difr_grid(b + ((i%st)+n*(i/st)), n,st, q, bord,tmp,3);
1095 		delete []tmp;
1096 	}
1097 #endif
1098 	return 0;
1099 }
mgl_datac_diffr(HADT d,const char * how,mreal q)1100 void MGL_EXPORT mgl_datac_diffr(HADT d, const char *how, mreal q)
1101 {
1102 	if(!how || *how==0)	return;
1103 	long nx=d->nx,ny=d->ny,nz=d->nz;
1104 	long p[4]={0,0,0,0};
1105 	dual qq=q;
1106 	if(mglchr(how,'e'))	p[3]=-1;
1107 	if(mglchr(how,'g'))	p[3]=-2;
1108 	if(mglchr(how,'1'))	p[3]=1;
1109 	if(mglchr(how,'2'))	p[3]=2;
1110 	if(mglchr(how,'3'))	p[3]=3;
1111 	bool axial = mglchr(how,'r')||mglchr(how,'a');
1112 	if(mglchr(how,'z') && nz>1)
1113 	{
1114 		p[0]=nz;	p[1]=nx*ny;	p[2]=0;
1115 		mglStartThreadC(mgl_difr,0,nx*ny,d->a,&qq,0,p);
1116 	}
1117 	if(mglchr(how,'y') && ny>1)
1118 	{
1119 		p[0]=ny;	p[1]=nx;	p[2]=0;
1120 		mglStartThreadC(mgl_difr,0,nx*nz,d->a,&qq,0,p);
1121 	}
1122 	if(axial && nx>1)
1123 	{
1124 		p[0]=nx;	p[1]=1;	p[2]=1;
1125 		mglStartThreadC(mgl_difr,0,ny*nz,d->a,&qq,0,p);
1126 	}
1127 	else if(mglchr(how,'x') && nx>1)
1128 	{
1129 		p[0]=nx;	p[1]=1;	p[2]=0;
1130 		mglStartThreadC(mgl_difr,0,ny*nz,d->a,&qq,0,p);
1131 	}
1132 }
1133 //-----------------------------------------------------------------------------
mgl_datac_diffr_(uintptr_t * d,const char * how,double q,int l)1134 void MGL_EXPORT mgl_datac_diffr_(uintptr_t *d, const char *how, double q,int l)
1135 {	char *s=new char[l+1];	memcpy(s,how,l);	s[l]=0;
1136 	mgl_datac_diffr(_DC_,s,q);	delete []s;	}
1137 //-----------------------------------------------------------------------------
mgl_gsplinec_init(HCDT x,HCDT v)1138 HADT MGL_EXPORT mgl_gsplinec_init(HCDT x, HCDT v)
1139 {
1140 	long n = v->GetNx();
1141 	if(!x || x->GetNx()!=n)	return 0;
1142 	mglDataC *res = new mglDataC(5*(n-1));
1143 	mreal *xx=0;
1144 	dual *vv=0;
1145 	const mglData *dx = dynamic_cast<const mglData *>(x);
1146 	if(!dx)
1147 	{
1148 		xx = new mreal[n];
1149 		for(long i=0;i<n;i++)	xx[i] = x->v(i);
1150 	}
1151 	const mglDataC *dv = dynamic_cast<const mglDataC *>(v);
1152 	if(!dv)
1153 	{
1154 		vv = new dual[n];
1155 		for(long i=0;i<n;i++)	vv[i] = v->v(i);
1156 	}
1157 	mgl_gspline_init(n,dx?dx->a:xx,dv?dv->a:vv,res->a);
1158 	if(xx)	delete []xx;
1159 	if(vv)	delete []vv;
1160 	return res;
1161 }
mgl_gsplinec_init_(uintptr_t * x,uintptr_t * v)1162 uintptr_t MGL_EXPORT mgl_gsplinec_init_(uintptr_t *x, uintptr_t *v)
1163 {	return uintptr_t(mgl_gspline_init(_DA_(x),_DA_(v)));	}
1164 //-----------------------------------------------------------------------------
mgl_gsplinec(HCDT c,mreal dx,mdual * d1,mdual * d2)1165 cmdual MGL_EXPORT mgl_gsplinec(HCDT c, mreal dx, mdual *d1, mdual *d2)
1166 {
1167 	long i=0, n = c->GetNx();
1168 	if(n%5)	return mdual(NAN);	// not the table of coefficients
1169 	while(dx>c->v(5*i) && i<n-1)	{	dx-=c->v(5*i);	i++;	}
1170 	dual res;
1171 	const mglDataC *d = dynamic_cast<const mglDataC *>(c);
1172 	if(d)
1173 	{
1174 		const dual *a = d->a+5*i;
1175 		if(d1)	*d1 = a[2]+dx*(mreal(2)*a[3]+(3*dx)*a[4]);
1176 		if(d2)	*d2 = mreal(2)*a[3]+(6*dx)*a[4];
1177 		res = a[1]+dx*(a[2]+dx*(a[3]+dx*a[4]));
1178 	}
1179 	else
1180 	{
1181 		if(d1)	*d1 = c->v(5*i+2)+dx*(2*c->v(5*i+3)+3*dx*c->v(5*i+4));
1182 		if(d2)	*d2 = 2*c->v(5*i+3)+6*dx*c->v(5*i+4);
1183 		res = c->v(5*i+1)+dx*(c->v(5*i+2)+dx*(c->v(5*i+3)+dx*c->v(5*i+4)));
1184 	}
1185 	return mdual(res);
1186 }
mgl_gsplinec_(uintptr_t * c,mreal * dx,mdual * d1,mdual * d2)1187 cmdual MGL_EXPORT mgl_gsplinec_(uintptr_t *c, mreal *dx, mdual *d1, mdual *d2)
1188 {	return mgl_gsplinec(_DA_(c),*dx,d1,d2);	}
1189 //-----------------------------------------------------------------------------
mgl_datac_refill_gs(HADT dat,HCDT xdat,HCDT vdat,mreal x1,mreal x2,long sl)1190 void MGL_EXPORT mgl_datac_refill_gs(HADT dat, HCDT xdat, HCDT vdat, mreal x1, mreal x2, long sl)
1191 {
1192 	HADT coef = mgl_gsplinec_init(xdat, vdat);
1193 	if(!coef)	return;	// incompatible dimensions
1194 	const long nx = dat->nx, nn=dat->ny*dat->nz;
1195 	mreal x0 = x1-xdat->v(0), dx = (x2-x1)/(nx-1);
1196 #pragma omp parallel for
1197 	for(long i=0;i<nx;i++)
1198 	{
1199 		dual d = mgl_gsplinec(coef,x0+dx*i,0,0);
1200 		if(sl<0)	for(long j=0;j<nn;j++)	dat->a[i+j*nx] = d;
1201 		else	dat->a[i+sl*nx] = d;
1202 	}
1203 	mgl_delete_datac(coef);
1204 }
1205 //-----------------------------------------------------------------------------
1206 mreal MGL_NO_EXPORT mgl_index_1(mreal v, HCDT dat);
mgl_datac_refill_x(HADT dat,HCDT xdat,HCDT vdat,mreal x1,mreal x2,long sl)1207 void MGL_EXPORT mgl_datac_refill_x(HADT dat, HCDT xdat, HCDT vdat, mreal x1, mreal x2, long sl)
1208 {
1209 	long nx=dat->nx,mx=vdat->GetNx(),nn=dat->ny*dat->nz;
1210 	if(mx!=xdat->GetNx())	return;	// incompatible dimensions
1211 	mreal dx = (x2-x1)/(nx-1);
1212 #pragma omp parallel for
1213 	for(long i=0;i<nx;i++)
1214 	{
1215 		mreal u = mgl_index_1(x1+dx*i,xdat);
1216 		dual d = mgl_datac_spline(vdat,u,0,0);
1217 		if(sl<0)	for(long j=0;j<nn;j++)	dat->a[i+j*nx] = d;
1218 		else	dat->a[i+sl*nx] = d;
1219 	}
1220 }
1221 //-----------------------------------------------------------------------------
mgl_datac_refill_xy(HADT dat,HCDT xdat,HCDT ydat,HCDT vdat,mreal x1,mreal x2,mreal y1,mreal y2,long sl)1222 void MGL_EXPORT mgl_datac_refill_xy(HADT dat, HCDT xdat, HCDT ydat, HCDT vdat, mreal x1, mreal x2, mreal y1, mreal y2, long sl)
1223 {
1224 	long nx=dat->nx,ny=dat->ny,nz=dat->nz,mx=vdat->GetNx(),my=vdat->GetNy(),nn=nx*ny;
1225 	bool both=(xdat->GetNN()==vdat->GetNN() && ydat->GetNN()==vdat->GetNN());
1226 	if(!both && (xdat->GetNx()!=mx || ydat->GetNx()!=my))	return;	// incompatible dimensions
1227 	mreal dx = (x2-x1)/(nx-1), dy = (y2-y1)/(ny-1);
1228 	if(both)
1229 	{
1230 #pragma omp parallel for
1231 		for(long i=0;i<nn*nz;i++)	dat->a[i]=NAN;
1232 #pragma omp parallel for collapse(2)
1233 		for(long j=0;j<my-1;j++)	for(long i=0;i<mx-1;i++)
1234 		{
1235 			long i0 = i+mx*j;
1236 			mreal vx0 = (xdat->vthr(i0)-x1)/dx, vy0 = (ydat->vthr(i0)-y1)/dy;
1237 			mreal vx1 = (xdat->vthr(i0+1)-x1)/dx, vy1 = (ydat->vthr(i0+1)-y1)/dy;
1238 			mreal vx2 = (xdat->vthr(i0+mx)-x1)/dx, vy2 = (ydat->vthr(i0+mx)-y1)/dy;
1239 			mreal vx3 = (xdat->vthr(i0+mx+1)-x1)/dx, vy3 = (ydat->vthr(i0+mx+1)-y1)/dy;
1240 			long xx1 = long(mgl_min( mgl_min(vx0,vx1), mgl_min(vx2,vx3) ));	// bounding box
1241 			long yy1 = long(mgl_min( mgl_min(vy0,vy1), mgl_min(vy2,vy3) ));
1242 			long xx2 = long(mgl_max( mgl_max(vx0,vx1), mgl_max(vx2,vx3) ));
1243 			long yy2 = long(mgl_max( mgl_max(vy0,vy1), mgl_max(vy2,vy3) ));
1244 			xx1=mgl_imax(xx1,0);	xx2=mgl_imin(xx2,nx-1);
1245 			yy1=mgl_imax(yy1,0);	yy2=mgl_imin(yy2,ny-1);
1246 			if(xx1>xx2 || yy1>yy2)	continue;
1247 
1248 			mreal d1x = vx1-vx0, d1y = vy1-vy0;
1249 			mreal d2x = vx2-vx0, d2y = vy2-vy0;
1250 			mreal d3x = vx3+vx0-vx1-vx2, d3y = vy3+vy0-vy1-vy2;
1251 			mreal dd = d1x*d2y-d1y*d2x;
1252 			mreal dsx =-4*(d2y*d3x - d2x*d3y)*d1y;
1253 			mreal dsy = 4*(d2y*d3x - d2x*d3y)*d1x;
1254 
1255 			for(long jj=yy1;jj<=yy2;jj++)	for(long ii=xx1;ii<=xx2;ii++)
1256 			{
1257 				mreal xx = (ii-vx0), yy = (jj-vy0);
1258 				mreal s = dsx*xx + dsy*yy + (dd+d3y*xx-d3x*yy)*(dd+d3y*xx-d3x*yy);
1259 				if(s>=0)
1260 				{
1261 					s = sqrt(s);
1262 					mreal qu = d3x*yy - d3y*xx + dd + s;
1263 					mreal qv = d3y*xx - d3x*yy + dd + s;
1264 					mreal u = 2.f*(d2y*xx - d2x*yy)/qu;
1265 					mreal v = 2.f*(d1x*yy - d1y*xx)/qv;
1266 					if(u*(1.f-u)<0.f || v*(1.f-v)<0.f)	// first root bad
1267 					{
1268 						qu = d3x*yy - d3y*xx + dd - s;
1269 						qv = d3y*xx - d3x*yy + dd - s;
1270 						u = 2.f*(d2y*xx - d2x*yy)/qu;
1271 						v = 2.f*(d1x*yy - d1y*xx)/qv;
1272 						if(u*(1.f-u)<0.f || v*(1.f-v)<0.f)	continue;	// second root bad
1273 					}
1274 					i0 = ii+nx*jj;	s = vdat->value(i+u,j+v,0);
1275 					if(sl<0)	for(long k=0;k<nz;k++)	dat->a[i0+k*nn] = s;
1276 					else	dat->a[i0+sl*nn] = s;
1277 				}
1278 			}
1279 		}
1280 	}
1281 	else
1282 	{
1283 		mglData u(nx), v(ny);
1284 #pragma omp parallel for
1285 		for(long i=0;i<nx;i++)	u.a[i] = mgl_index_1(x1+dx*i,xdat);
1286 #pragma omp parallel for
1287 		for(long i=0;i<ny;i++)	v.a[i] = mgl_index_1(y1+dy*i,ydat);
1288 #pragma omp parallel for collapse(2)
1289 		for(long j=0;j<ny;j++)	for(long i=0;i<nx;i++)
1290 		{
1291 			dual d = mgl_datac_spline(vdat,u.a[i],v.a[j],0);
1292 			long i0=i+nx*j;
1293 			if(sl<0)	for(long k=0;k<nz;k++)	dat->a[i0+k*nn] = d;
1294 			else	dat->a[i0+sl*nn] = d;
1295 		}
1296 	}
1297 }
1298 //-----------------------------------------------------------------------------
mgl_datac_refill_xyz(HADT dat,HCDT xdat,HCDT ydat,HCDT zdat,HCDT vdat,mreal x1,mreal x2,mreal y1,mreal y2,mreal z1,mreal z2)1299 void MGL_EXPORT mgl_datac_refill_xyz(HADT dat, HCDT xdat, HCDT ydat, HCDT zdat, HCDT vdat, mreal x1, mreal x2, mreal y1, mreal y2, mreal z1, mreal z2)
1300 {
1301 	if(!dat || !xdat || !ydat || !zdat || !vdat)	return;
1302 	long nx=dat->nx,ny=dat->ny,nz=dat->nz,mx=vdat->GetNx(),my=vdat->GetNy(),mz=vdat->GetNz();
1303 	bool both=(xdat->GetNN()==vdat->GetNN() && ydat->GetNN()==vdat->GetNN() && zdat->GetNN()==vdat->GetNN());
1304 	if(!both && (xdat->GetNx()!=mx || ydat->GetNx()!=my || zdat->GetNx()!=mz))	return;	// incompatible dimensions
1305 	const mreal acx=1e-6*fabs(x2-x1), acy=1e-6*fabs(y2-y1), acz=1e-6*fabs(z2-z1);
1306 	if(both)
1307 #pragma omp parallel for collapse(3)
1308 		for(long k=0;k<nz;k++)	for(long j=0;j<ny;j++)	for(long i=0;i<nx;i++)
1309 		{
1310 			mreal xx = x1+(x2-x1)*i/(nx-1.),dxx,dxy,dxz,vx,dx=0,dd;
1311 			mreal yy = y1+(y2-y1)*j/(ny-1.),dyx,dyy,dyz,vy,dy=0;
1312 			mreal zz = z1+(z2-z1)*k/(nz-1.),dzx,dzy,dzz,vz,dz=0;
1313 			vx = xdat->valueD(dx,dy,dz,&dxx,&dxy,&dxz);
1314 			vy = ydat->valueD(dx,dy,dz,&dyx,&dyy,&dyz);
1315 			vz = zdat->valueD(dx,dy,dz,&dzx,&dzy,&dzz);
1316 			long count=0;
1317 			do	// use Newton method to find root
1318 			{
1319 				if(count>50)	{	dx=NAN;	break;	}	count++;
1320 				dd = -dxx*dyy*dzz+dxy*dyx*dzz+dxx*dyz*dzy-dxz*dyx*dzy-dxy*dyz*dzx+dxz*dyy*dzx;
1321 				dx += ((dyz*dzy-dyy*dzz)*(xx-vx)+(dxy*dzz-dxz*dzy)*(yy-vy)+(dxz*dyy-dxy*dyz)*(zz-vz))/dd;
1322 				dy += ((dyx*dzz-dyz*dzx)*(xx-vx)+(dxz*dzx-dxx*dzz)*(yy-vy)+(dxx*dyz-dxz*dyx)*(zz-vz))/dd;
1323 				dz += ((dyy*dzx-dyx*dzy)*(xx-vx)+(dxx*dzy-dxy*dzx)*(yy-vy)+(dxy*dyx-dxx*dyy)*(zz-vz))/dd;
1324 				vx = xdat->valueD(dx,dy,dz,&dxx,&dxy,&dxz);
1325 				vy = ydat->valueD(dx,dy,dz,&dyx,&dyy,&dyz);
1326 				vz = zdat->valueD(dx,dy,dz,&dzx,&dzy,&dzz);
1327 			}	while(fabs(xx-vx)>acx && fabs(yy-vy)>acy && fabs(zz-vz)>acz);	// this valid for linear interpolation
1328 			dat->a[i+nx*(j+ny*k)] = mgl_isnan(dx)?NAN:vdat->value(dx,dy,dz);
1329 		}
1330 	else
1331 	{
1332 		mglData u(nx), v(ny), w(nz);
1333 		mreal dx = (x2-x1)/(nx-1), dy = (y2-y1)/(ny-1), dz = (z2-z1)/(nz-1);
1334 #pragma omp parallel for
1335 		for(long i=0;i<nx;i++)	u.a[i] = mgl_index_1(x1+dx*i,xdat);
1336 #pragma omp parallel for
1337 		for(long i=0;i<ny;i++)	v.a[i] = mgl_index_1(y1+dy*i,ydat);
1338 #pragma omp parallel for
1339 		for(long i=0;i<nz;i++)	w.a[i] = mgl_index_1(z1+dz*i,zdat);
1340 #pragma omp parallel for collapse(3)
1341 		for(long k=0;k<nz;k++)	for(long j=0;j<ny;j++)	for(long i=0;i<nx;i++)
1342 			dat->a[i+nx*(j+ny*k)] = mgl_datac_spline(vdat,u.a[i],v.a[j],w.a[k]);
1343 	}
1344 }
1345 //-----------------------------------------------------------------------------
mgl_diffc_3(void * par)1346 static void *mgl_diffc_3(void *par)
1347 {
1348 	mglThreadC *t=(mglThreadC *)par;
1349 	long nx=t->p[0], ny=t->p[1], nz=t->p[2], nn=t->n, n2=nx*ny;
1350 	dual *b=t->a,au,av,aw;
1351 	HCDT x=(HCDT)(t->c),y=(HCDT)(t->d),z=(HCDT)(t->e);
1352 	const dual *a=t->b;
1353 #if !MGL_HAVE_PTHREAD
1354 #pragma omp parallel for private(au,av,aw)
1355 #endif
1356 	for(long i0=t->id;i0<nn;i0+=mglNumThr)
1357 	{
1358 		long i=i0%nx, j=((i0/nx)%ny), k=i0/(nx*ny);
1359 		mreal xu,xv,xw,yu,yv,yw,zu,zv,zw;
1360 		if(i==0)
1361 		{
1362 			au = mreal(3)*a[i0]-mreal(4)*a[i0+1]+a[i0+2];
1363 			xu = 3*x->vthr(i0)-4*x->vthr(i0+1)+x->vthr(i0+2);
1364 			yu = 3*y->vthr(i0)-4*y->vthr(i0+1)+y->vthr(i0+2);
1365 			zu = 3*z->vthr(i0)-4*z->vthr(i0+1)+z->vthr(i0+2);
1366 		}
1367 		else if(i==nx-1)
1368 		{
1369 			au = mreal(3)*a[i0]-mreal(4)*a[i0-1]+a[i0-2];
1370 			xu = 3*x->vthr(i0)-4*x->vthr(i0-1)+x->vthr(i0-2);
1371 			yu = 3*y->vthr(i0)-4*y->vthr(i0-1)+y->vthr(i0-2);
1372 			zu = 3*z->vthr(i0)-4*z->vthr(i0-1)+z->vthr(i0-2);
1373 		}
1374 		else
1375 		{
1376 			au = a[i0+1]-a[i0-1];
1377 			xu = x->vthr(i0+1)-x->vthr(i0-1);
1378 			yu = y->vthr(i0+1)-y->vthr(i0-1);
1379 			zu = z->vthr(i0+1)-z->vthr(i0-1);
1380 		}
1381 		if(j==0)
1382 		{
1383 			av = mreal(3)*a[i0]-mreal(4)*a[i0+nx]+a[i0+2*nx];
1384 			xv = 3*x->vthr(i0)-4*x->vthr(i0+nx)+x->vthr(i0+2*nx);
1385 			yv = 3*y->vthr(i0)-4*y->vthr(i0+nx)+y->vthr(i0+2*nx);
1386 			zv = 3*z->vthr(i0)-4*z->vthr(i0+nx)+z->vthr(i0+2*nx);
1387 		}
1388 		else if(j==ny-1)
1389 		{
1390 			av = mreal(3)*a[i0]-mreal(4)*a[i0-nx]+a[i0+(ny-3)*nx];
1391 			xv = 3*x->vthr(i0)-4*x->vthr(i0-nx)+x->vthr(i0-2*nx);
1392 			yv = 3*y->vthr(i0)-4*y->vthr(i0-nx)+y->vthr(i0-2*nx);
1393 			zv = 3*z->vthr(i0)-4*z->vthr(i0-nx)+z->vthr(i0-2*nx);
1394 		}
1395 		else
1396 		{
1397 			av = a[i0+nx]-a[i0-nx];
1398 			xv = x->vthr(i0+nx)-x->vthr(i0-nx);
1399 			yv = y->vthr(i0+nx)-y->vthr(i0-nx);
1400 			zv = z->vthr(i0+nx)-z->vthr(i0-nx);
1401 		}
1402 		if(k==0)
1403 		{
1404 			aw = mreal(3)*a[i0]-mreal(4)*a[i0+n2]+a[i0+2*n2];
1405 			xw = 3*x->vthr(i0)-4*x->vthr(i0+n2)+x->vthr(i0+2*n2);
1406 			yw = 3*y->vthr(i0)-4*y->vthr(i0+n2)+y->vthr(i0+2*n2);
1407 			zw = 3*z->vthr(i0)-4*z->vthr(i0+n2)+z->vthr(i0+2*n2);
1408 		}
1409 		else if(k==nz-1)
1410 		{
1411 			aw = mreal(3)*a[i0]-mreal(4)*a[i0-n2]+a[i0-2*n2];
1412 			xw = 3*x->vthr(i0)-4*x->vthr(i0-n2)+x->vthr(i0-2*n2);
1413 			yw = 3*y->vthr(i0)-4*y->vthr(i0-n2)+y->vthr(i0-2*n2);
1414 			zw = 3*z->vthr(i0)-4*z->vthr(i0-n2)+z->vthr(i0-2*n2);
1415 		}
1416 		else
1417 		{
1418 			aw = a[i0+n2]-a[i0-n2];
1419 			xw = x->vthr(i0+n2)-x->vthr(i0-n2);
1420 			yw = y->vthr(i0+n2)-y->vthr(i0-n2);
1421 			zw = z->vthr(i0+n2)-z->vthr(i0-n2);
1422 		}
1423 		b[i0] = (au*yv*zw-av*yu*zw-au*yw*zv+aw*yu*zv+av*yw*zu-aw*yv*zu) / (xu*yv*zw-xv*yu*zw-xu*yw*zv+xw*yu*zv+xv*yw*zu-xw*yv*zu);
1424 	}
1425 	return 0;
1426 }
mgl_diffc_2(void * par)1427 static void *mgl_diffc_2(void *par)
1428 {
1429 	mglThreadC *t=(mglThreadC *)par;
1430 	long nx=t->p[0], ny=t->p[1], nn=t->n, same=t->p[2];
1431 	dual *b=t->a,au,av;
1432 	HCDT x=(HCDT)(t->c),y=(HCDT)(t->d);
1433 	const dual *a=t->b;
1434 #if !MGL_HAVE_PTHREAD
1435 #pragma omp parallel for private(au,av)
1436 #endif
1437 	for(long i0=t->id;i0<nn;i0+=mglNumThr)
1438 	{
1439 		long i=i0%nx, j=((i0/nx)%ny), i1 = same ? i0 : i0%(nx*ny);
1440 		mreal xu,xv,yu,yv;
1441 		if(i==0)
1442 		{
1443 			au = mreal(3)*a[i0]-mreal(4)*a[i0+1]+a[i0+2];
1444 			xu = 3*x->vthr(i1)-4*x->vthr(i1+1)+x->vthr(i1+2);
1445 			yu = 3*y->vthr(i1)-4*y->vthr(i1+1)+y->vthr(i1+2);
1446 		}
1447 		else if(i==nx-1)
1448 		{
1449 			au = mreal(3)*a[i0]-mreal(4)*a[i0-1]+a[i0-2];
1450 			xu = 3*x->vthr(i1)-4*x->vthr(i1-1)+x->vthr(i1-2);
1451 			yu = 3*y->vthr(i1)-4*y->vthr(i1-1)+y->vthr(i1-2);
1452 		}
1453 		else
1454 		{
1455 			au = a[i0+1]-a[i0-1];
1456 			xu = x->vthr(i1+1)-x->vthr(i1-1);
1457 			yu = y->vthr(i1+1)-y->vthr(i1-1);
1458 		}
1459 		if(j==0)
1460 		{
1461 			av = mreal(3)*a[i0]-mreal(4)*a[i0+nx]+a[i0+2*nx];
1462 			xv = 3*x->vthr(i1)-4*x->vthr(i1+nx)+x->vthr(i1+2*nx);
1463 			yv = 3*y->vthr(i1)-4*y->vthr(i1+nx)+y->vthr(i1+2*nx);
1464 		}
1465 		else if(j==ny-1)
1466 		{
1467 			av = mreal(3)*a[i0]-mreal(4)*a[i0-nx]+a[i0-2*nx];
1468 			xv = 3*x->vthr(i1)-4*x->vthr(i1-nx)+x->vthr(i1-2*nx);
1469 			yv = 3*y->vthr(i1)-4*y->vthr(i1-nx)+y->vthr(i1-2*nx);
1470 		}
1471 		else
1472 		{
1473 			av = a[i0+nx]-a[i0-nx];
1474 			xv = x->vthr(i1+nx)-x->vthr(i1-nx);
1475 			yv = y->vthr(i1+nx)-y->vthr(i1-nx);
1476 		}
1477 		b[i0] = (av*yu-au*yv)/(xv*yu-xu*yv);
1478 	}
1479 	return 0;
1480 }
mgl_diffc_1(void * par)1481 static void *mgl_diffc_1(void *par)
1482 {
1483 	mglThreadC *t=(mglThreadC *)par;
1484 	long nx=t->p[0], nn=t->n, same=t->p[1];
1485 	dual *b=t->a,au;
1486 	HCDT x=(HCDT)(t->c);
1487 	const dual *a=t->b;
1488 #if !MGL_HAVE_PTHREAD
1489 #pragma omp parallel for private(au)
1490 #endif
1491 	for(long i0=t->id;i0<nn;i0+=mglNumThr)
1492 	{
1493 		long i=i0%nx, i1 = same ? i0 : i;
1494 		mreal xu;
1495 		if(i==0)
1496 		{
1497 			au = mreal(3)*a[i0]-mreal(4)*a[i0+1]+a[i0+2];
1498 			xu = 3*x->vthr(i1)-4*x->vthr(i1+1)+x->vthr(i1+2);
1499 		}
1500 		else if(i==nx-1)
1501 		{
1502 			au = mreal(3)*a[i0]-mreal(4)*a[i0-1]+a[i0-2];
1503 			xu = 3*x->vthr(i1)-4*x->vthr(i1-1)+x->vthr(i1-2);
1504 		}
1505 		else
1506 		{
1507 			au = a[i0+1]-a[i0-1];
1508 			xu = x->vthr(i1+1)-x->vthr(i1-1);
1509 		}
1510 		b[i0] = au/xu;
1511 	}
1512 	return 0;
1513 }
mgl_datac_diff_par(HADT d,HCDT x,HCDT y,HCDT z)1514 void MGL_EXPORT mgl_datac_diff_par(HADT d, HCDT x, HCDT y, HCDT z)
1515 {
1516 	long nx=d->GetNx(),ny=d->GetNy(),nz=d->GetNz(), nn=nx*ny*nz;
1517 	if(nx<2 || ny<2)	return;
1518 	dual *b = new dual[nn];	memset(b,0,nn*sizeof(dual));
1519 	long p[3]={nx,ny,nz};
1520 
1521 	if(x&&y&&z && x->GetNN()==nn && y->GetNN()==nn && z->GetNN()==nn)
1522 		mglStartThreadC(mgl_diffc_3,0,nn,b,d->a,(const dual *)x,p,0,(const dual *)y,(const dual *)z);
1523 	else if(x&&y && x->GetNx()*x->GetNy()==nx*ny && y->GetNx()*y->GetNy()==nx*ny)
1524 	{
1525 		p[2]=(x->GetNz()==nz && y->GetNz()==nz);
1526 		mglStartThreadC(mgl_diffc_2,0,nn,b,d->a,(const dual *)x,p,0,(const dual *)y);
1527 	}
1528 	else if(x && x->GetNx()==nx)
1529 	{
1530 		p[1]=(x->GetNy()*x->GetNz()==ny*nz);
1531 		mglStartThreadC(mgl_diffc_1,0,nn,b,d->a,(const dual *)x,p,0,0);
1532 	}
1533 	memcpy(d->a,b,nn*sizeof(dual));	delete []b;
1534 }
mgl_datac_diff_par_(uintptr_t * d,uintptr_t * v1,uintptr_t * v2,uintptr_t * v3)1535 void MGL_EXPORT mgl_datac_diff_par_(uintptr_t *d, uintptr_t *v1, uintptr_t *v2, uintptr_t *v3)
1536 {	mgl_datac_diff_par(_DC_,_DA_(v1),_DA_(v2),_DA_(v3));	}
1537 //-----------------------------------------------------------------------------
1538