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