NEURON
nvector_nrnparallel_ld.cpp
Go to the documentation of this file.
1 /*
2  * -----------------------------------------------------------------
3  * $Revision: 855 $
4  * $Date: 2005-02-10 00:15:46 +0100 (Thu, 10 Feb 2005) $
5  * -----------------------------------------------------------------
6  * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban,
7  * and Aaron Collier @ LLNL
8  * -----------------------------------------------------------------
9  * Copyright (c) 2002, The Regents of the University of California.
10  * Produced at the Lawrence Livermore National Laboratory.
11  * All rights reserved.
12  * For details, see sundials/shared/LICENSE.
13  * -----------------------------------------------------------------
14  * This is the implementation file for a parallel MPI implementation
15  * of the NVECTOR package.
16  * -----------------------------------------------------------------
17  */
18 #include <../../nrnconf.h>
19 #include <hocassrt.h>
20 
21 #include <stdio.h>
22 #include <stdlib.h>
23 
24 #include <nrnmpiuse.h>
25 #include <nrnmpidec.h>
26 extern int nrnmpi_numprocs;
27 
28 #include "nvector_nrnparallel_ld.h"
29 #include "sundialsmath.h"
30 #include "sundialstypes.h"
31 
32 #define ZERO RCONST(0.0)
33 #define HALF RCONST(0.5)
34 #define ONE RCONST(1.0)
35 #define ONEPT5 RCONST(1.5)
36 
37 /* Error Message */
38 
39 #define BAD_N1 "N_VNew_NrnParallelLD -- Sum of local vector lengths differs from "
40 #define BAD_N2 "input global length. \n\n"
41 #define BAD_N BAD_N1 BAD_N2
42 
43 /* Private function prototypes */
44 
45 /* Reduction operations add/max/min over the processor group */
46 static realtype VAllReduce_NrnParallelLD(realtype d, int op, MPI_Comm comm);
47 /* only for sum */
48 static realtype VAllReduce_long_NrnParallelLD(realtype d, int op, MPI_Comm comm);
49 /* z=x */
50 static void VCopy_NrnParallelLD(N_Vector x, N_Vector z);
51 /* z=x+y */
52 static void VSum_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z);
53 /* z=x-y */
54 static void VDiff_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z);
55 /* z=-x */
56 static void VNeg_NrnParallelLD(N_Vector x, N_Vector z);
57 /* z=c(x+y) */
58 static void VScaleSum_NrnParallelLD(realtype c, N_Vector x, N_Vector y, N_Vector z);
59 /* z=c(x-y) */
60 static void VScaleDiff_NrnParallelLD(realtype c, N_Vector x, N_Vector y, N_Vector z);
61 /* z=ax+y */
62 static void VLin1_NrnParallelLD(realtype a, N_Vector x, N_Vector y, N_Vector z);
63 /* z=ax-y */
64 static void VLin2_NrnParallelLD(realtype a, N_Vector x, N_Vector y, N_Vector z);
65 /* y <- ax+y */
66 static void Vaxpy_NrnParallelLD(realtype a, N_Vector x, N_Vector y);
67 /* x <- ax */
68 static void VScaleBy_NrnParallelLD(realtype a, N_Vector x);
69 
70 /*
71  * -----------------------------------------------------------------
72  * exported functions
73  * -----------------------------------------------------------------
74  */
75 
76 /* ----------------------------------------------------------------
77  * Function to create a new parallel vector with empty data array
78  */
79 
80 N_Vector N_VNewEmpty_NrnParallelLD(MPI_Comm comm, long int local_length, long int global_length) {
81  N_Vector v;
82  N_Vector_Ops ops;
84  long int n, Nsum;
85 
86  /* Compute global length as sum of local lengths */
87  n = local_length;
88  nrnmpi_long_allreduce_vec(&n, &Nsum, 1, 1);
89  if (Nsum != global_length) {
90  printf(BAD_N);
91  return (NULL);
92  }
93 
94  /* Create vector */
95  v = (N_Vector) malloc(sizeof *v);
96  if (v == NULL)
97  return (NULL);
98 
99  /* Create vector operation structure */
100  ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops));
101  if (ops == NULL) {
102  free(v);
103  return (NULL);
104  }
105 
106  ops->nvclone = N_VClone_NrnParallelLD;
107  ops->nvdestroy = N_VDestroy_NrnParallelLD;
108  ops->nvspace = N_VSpace_NrnParallelLD;
109  ops->nvgetarraypointer = N_VGetArrayPointer_NrnParallelLD;
110  ops->nvsetarraypointer = N_VSetArrayPointer_NrnParallelLD;
111  ops->nvlinearsum = N_VLinearSum_NrnParallelLD;
112  ops->nvconst = N_VConst_NrnParallelLD;
113  ops->nvprod = N_VProd_NrnParallelLD;
114  ops->nvdiv = N_VDiv_NrnParallelLD;
115  ops->nvscale = N_VScale_NrnParallelLD;
116  ops->nvabs = N_VAbs_NrnParallelLD;
117  ops->nvinv = N_VInv_NrnParallelLD;
118  ops->nvaddconst = N_VAddConst_NrnParallelLD;
119  ops->nvdotprod = N_VDotProd_NrnParallelLD;
120  ops->nvmaxnorm = N_VMaxNorm_NrnParallelLD;
121  ops->nvwrmsnormmask = N_VWrmsNormMask_NrnParallelLD;
122  ops->nvwrmsnorm = N_VWrmsNorm_NrnParallelLD;
123  ops->nvmin = N_VMin_NrnParallelLD;
124  ops->nvwl2norm = N_VWL2Norm_NrnParallelLD;
125  ops->nvl1norm = N_VL1Norm_NrnParallelLD;
126  ops->nvcompare = N_VCompare_NrnParallelLD;
127  ops->nvinvtest = N_VInvTest_NrnParallelLD;
128  ops->nvconstrmask = N_VConstrMask_NrnParallelLD;
129  ops->nvminquotient = N_VMinQuotient_NrnParallelLD;
130 
131  /* Create content */
132  content = (N_VectorContent_NrnParallelLD) malloc(sizeof(struct _N_VectorContent_NrnParallelLD));
133  if (content == NULL) {
134  free(ops);
135  free(v);
136  return (NULL);
137  }
138 
139  /* Attach lengths and communicator */
140  content->local_length = local_length;
141  content->global_length = global_length;
142  content->comm = comm;
143  content->own_data = FALSE;
144  content->data = NULL;
145 
146  /* Attach content and ops */
147  v->content = content;
148  v->ops = ops;
149 
150  return (v);
151 }
152 
153 /* ----------------------------------------------------------------
154  * Function to create a new parallel vector
155  */
156 
157 extern "C" N_Vector N_VNew_NrnParallelLD(MPI_Comm comm,
158  long int local_length,
159  long int global_length) {
160  N_Vector v;
161  realtype* data;
162 
163  v = N_VNewEmpty_NrnParallelLD(comm, local_length, global_length);
164  if (v == NULL)
165  return (NULL);
166 
167  /* Create data */
168  if (local_length > 0) {
169  /* Allocate memory */
170  data = (realtype*) malloc(local_length * sizeof(realtype));
171  if (data == NULL) {
173  return (NULL);
174  }
175 
176  /* Attach data */
178  NV_DATA_P_LD(v) = data;
179  }
180 
181  return (v);
182 }
183 
184 /* ----------------------------------------------------------------------------
185  * Function to clone from a template a new vector with empty (NULL) data array
186  */
187 
188 N_Vector N_VCloneEmpty_NrnParallelLD(N_Vector w) {
189  N_Vector v;
190  N_Vector_Ops ops;
192 
193  if (w == NULL)
194  return (NULL);
195 
196  /* Create vector */
197  v = (N_Vector) malloc(sizeof *v);
198  if (v == NULL)
199  return (NULL);
200 
201  /* Create vector operation structure */
202  ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops));
203  if (ops == NULL) {
204  free(v);
205  return (NULL);
206  }
207 
208  ops->nvclone = w->ops->nvclone;
209  ops->nvdestroy = w->ops->nvdestroy;
210  ops->nvspace = w->ops->nvspace;
211  ops->nvgetarraypointer = w->ops->nvgetarraypointer;
212  ops->nvsetarraypointer = w->ops->nvsetarraypointer;
213  ops->nvlinearsum = w->ops->nvlinearsum;
214  ops->nvconst = w->ops->nvconst;
215  ops->nvprod = w->ops->nvprod;
216  ops->nvdiv = w->ops->nvdiv;
217  ops->nvscale = w->ops->nvscale;
218  ops->nvabs = w->ops->nvabs;
219  ops->nvinv = w->ops->nvinv;
220  ops->nvaddconst = w->ops->nvaddconst;
221  ops->nvdotprod = w->ops->nvdotprod;
222  ops->nvmaxnorm = w->ops->nvmaxnorm;
223  ops->nvwrmsnormmask = w->ops->nvwrmsnormmask;
224  ops->nvwrmsnorm = w->ops->nvwrmsnorm;
225  ops->nvmin = w->ops->nvmin;
226  ops->nvwl2norm = w->ops->nvwl2norm;
227  ops->nvl1norm = w->ops->nvl1norm;
228  ops->nvcompare = w->ops->nvcompare;
229  ops->nvinvtest = w->ops->nvinvtest;
230  ops->nvconstrmask = w->ops->nvconstrmask;
231  ops->nvminquotient = w->ops->nvminquotient;
232 
233  /* Create content */
234  content = (N_VectorContent_NrnParallelLD) malloc(sizeof(struct _N_VectorContent_NrnParallelLD));
235  if (content == NULL) {
236  free(ops);
237  free(v);
238  return (NULL);
239  }
240 
241  /* Attach lengths and communicator */
242  content->local_length = NV_LOCLENGTH_P_LD(w);
243  content->global_length = NV_GLOBLENGTH_P_LD(w);
244  content->comm = NV_COMM_P_LD(w);
245  content->own_data = FALSE;
246  content->data = NULL;
247 
248  /* Attach content and ops */
249  v->content = content;
250  v->ops = ops;
251 
252  return (v);
253 }
254 
255 /* ----------------------------------------------------------------
256  * Function to create a parallel N_Vector with user data component
257  */
258 
260  long int local_length,
261  long int global_length,
262  realtype* v_data) {
263  N_Vector v;
264 
265  v = N_VNewEmpty_NrnParallelLD(comm, local_length, global_length);
266  if (v == NULL)
267  return (NULL);
268 
269  if (local_length > 0) {
270  /* Attach data */
272  NV_DATA_P_LD(v) = v_data;
273  }
274 
275  return (v);
276 }
277 
278 /* ----------------------------------------------------------------
279  * Function to create an array of new parallel vectors.
280  */
281 
283  MPI_Comm comm,
284  long int local_length,
285  long int global_length) {
286  N_Vector* vs;
287  int j;
288 
289  if (count <= 0)
290  return (NULL);
291 
292  vs = (N_Vector*) malloc(count * sizeof(N_Vector));
293  if (vs == NULL)
294  return (NULL);
295 
296  for (j = 0; j < count; j++) {
297  vs[j] = N_VNew_NrnParallelLD(comm, local_length, global_length);
298  if (vs[j] == NULL) {
300  return (NULL);
301  }
302  }
303 
304  return (vs);
305 }
306 
307 /* ----------------------------------------------------------------
308  * Function to create an array of new parallel vectors with empty
309  * (NULL) data array.
310  */
311 
313  MPI_Comm comm,
314  long int local_length,
315  long int global_length) {
316  N_Vector* vs;
317  int j;
318 
319  if (count <= 0)
320  return (NULL);
321 
322  vs = (N_Vector*) malloc(count * sizeof(N_Vector));
323  if (vs == NULL)
324  return (NULL);
325 
326  for (j = 0; j < count; j++) {
327  vs[j] = N_VNewEmpty_NrnParallelLD(comm, local_length, global_length);
328  if (vs[j] == NULL) {
330  return (NULL);
331  }
332  }
333 
334  return (vs);
335 }
336 
337 /* ----------------------------------------------------------------
338  * Function to free an array created with N_VNewVectorArray_NrnParallelLD
339  */
340 
341 void N_VDestroyVectorArray_NrnParallelLD(N_Vector* vs, int count) {
342  int j;
343 
344  for (j = 0; j < count; j++)
346 
347  free(vs);
348 }
349 
350 /* ----------------------------------------------------------------
351  * Function to print a parallel vector
352  */
353 
354 void N_VPrint_NrnParallelLD(N_Vector x) {
355  long int i, N;
356  realtype* xd;
357 
358  N = NV_LOCLENGTH_P_LD(x);
359  xd = NV_DATA_P_LD(x);
360 
361  for (i = 0; i < N; i++) {
362  printf("%lg\n", *xd++);
363  }
364  printf("\n");
365 }
366 
367 /*
368  * -----------------------------------------------------------------
369  * implementation of vector operations
370  * -----------------------------------------------------------------
371  */
372 
373 N_Vector N_VClone_NrnParallelLD(N_Vector w) {
374  N_Vector v;
375  realtype* data;
376  long int local_length;
377 
379  if (v == NULL)
380  return (NULL);
381 
382  local_length = NV_LOCLENGTH_P_LD(w);
383 
384  /* Create data */
385  if (local_length > 0) {
386  /* Allocate memory */
387  data = (realtype*) malloc(local_length * sizeof(realtype));
388  if (data == NULL) {
390  return (NULL);
391  }
392 
393  /* Attach data */
395  NV_DATA_P_LD(v) = data;
396  }
397 
398  return (v);
399 }
400 
401 void N_VDestroy_NrnParallelLD(N_Vector v) {
402  if ((NV_OWN_DATA_P_LD(v) == TRUE) && (NV_DATA_P_LD(v) != NULL))
403  free(NV_DATA_P_LD(v));
404  free(v->content);
405  free(v->ops);
406  free(v);
407 }
408 
409 void N_VSpace_NrnParallelLD(N_Vector v, long int* lrw, long int* liw) {
410  MPI_Comm comm;
411  int npes;
412 
413  comm = NV_COMM_P_LD(v);
414  npes = nrnmpi_numprocs;
415 
416  *lrw = NV_GLOBLENGTH_P_LD(v);
417  *liw = 2 * npes;
418 }
419 
420 realtype* N_VGetArrayPointer_NrnParallelLD(N_Vector v) {
421  realtype* v_data;
422 
423  v_data = NV_DATA_P_LD(v);
424 
425  return (v_data);
426 }
427 
428 void N_VSetArrayPointer_NrnParallelLD(realtype* v_data, N_Vector v) {
429  if (NV_LOCLENGTH_P_LD(v) > 0)
430  NV_DATA_P_LD(v) = v_data;
431 }
432 
433 void N_VLinearSum_NrnParallelLD(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) {
434  long int i, N;
435  realtype c, *xd, *yd, *zd;
436  N_Vector v1, v2;
437  booleantype test;
438 
439  if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */
440  Vaxpy_NrnParallelLD(a, x, y);
441  return;
442  }
443 
444  if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */
445  Vaxpy_NrnParallelLD(b, y, x);
446  return;
447  }
448 
449  /* Case: a == b == 1.0 */
450 
451  if ((a == ONE) && (b == ONE)) {
452  VSum_NrnParallelLD(x, y, z);
453  return;
454  }
455 
456  /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */
457 
458  if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) {
459  v1 = test ? y : x;
460  v2 = test ? x : y;
461  VDiff_NrnParallelLD(v2, v1, z);
462  return;
463  }
464 
465  /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */
466  /* if a or b is 0.0, then user should have called N_VScale */
467 
468  if ((test = (a == ONE)) || (b == ONE)) {
469  c = test ? b : a;
470  v1 = test ? y : x;
471  v2 = test ? x : y;
472  VLin1_NrnParallelLD(c, v1, v2, z);
473  return;
474  }
475 
476  /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */
477 
478  if ((test = (a == -ONE)) || (b == -ONE)) {
479  c = test ? b : a;
480  v1 = test ? y : x;
481  v2 = test ? x : y;
482  VLin2_NrnParallelLD(c, v1, v2, z);
483  return;
484  }
485 
486  /* Case: a == b */
487  /* catches case both a and b are 0.0 - user should have called N_VConst */
488 
489  if (a == b) {
490  VScaleSum_NrnParallelLD(a, x, y, z);
491  return;
492  }
493 
494  /* Case: a == -b */
495 
496  if (a == -b) {
497  VScaleDiff_NrnParallelLD(a, x, y, z);
498  return;
499  }
500 
501  /* Do all cases not handled above:
502  (1) a == other, b == 0.0 - user should have called N_VScale
503  (2) a == 0.0, b == other - user should have called N_VScale
504  (3) a,b == other, a !=b, a != -b */
505 
506  N = NV_LOCLENGTH_P_LD(x);
507  xd = NV_DATA_P_LD(x);
508  yd = NV_DATA_P_LD(y);
509  zd = NV_DATA_P_LD(z);
510 
511  for (i = 0; i < N; i++)
512  *zd++ = a * (*xd++) + b * (*yd++);
513 }
514 
515 void N_VConst_NrnParallelLD(realtype c, N_Vector z) {
516  long int i, N;
517  realtype* zd;
518 
519  N = NV_LOCLENGTH_P_LD(z);
520  zd = NV_DATA_P_LD(z);
521 
522  for (i = 0; i < N; i++)
523  *zd++ = c;
524 }
525 
526 void N_VProd_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z) {
527  long int i, N;
528  realtype *xd, *yd, *zd;
529 
530  N = NV_LOCLENGTH_P_LD(x);
531  xd = NV_DATA_P_LD(x);
532  yd = NV_DATA_P_LD(y);
533  zd = NV_DATA_P_LD(z);
534 
535  for (i = 0; i < N; i++)
536  *zd++ = (*xd++) * (*yd++);
537 }
538 
539 void N_VDiv_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z) {
540  long int i, N;
541  realtype *xd, *yd, *zd;
542 
543  N = NV_LOCLENGTH_P_LD(x);
544  xd = NV_DATA_P_LD(x);
545  yd = NV_DATA_P_LD(y);
546  zd = NV_DATA_P_LD(z);
547 
548  for (i = 0; i < N; i++)
549  *zd++ = (*xd++) / (*yd++);
550 }
551 
552 void N_VScale_NrnParallelLD(realtype c, N_Vector x, N_Vector z) {
553  long int i, N;
554  realtype *xd, *zd;
555 
556  if (z == x) { /* BLAS usage: scale x <- cx */
558  return;
559  }
560 
561  if (c == ONE) {
562  VCopy_NrnParallelLD(x, z);
563  } else if (c == -ONE) {
564  VNeg_NrnParallelLD(x, z);
565  } else {
566  N = NV_LOCLENGTH_P_LD(x);
567  xd = NV_DATA_P_LD(x);
568  zd = NV_DATA_P_LD(z);
569  for (i = 0; i < N; i++)
570  *zd++ = c * (*xd++);
571  }
572 }
573 
574 void N_VAbs_NrnParallelLD(N_Vector x, N_Vector z) {
575  long int i, N;
576  realtype *xd, *zd;
577 
578  N = NV_LOCLENGTH_P_LD(x);
579  xd = NV_DATA_P_LD(x);
580  zd = NV_DATA_P_LD(z);
581 
582  for (i = 0; i < N; i++, xd++, zd++)
583  *zd = ABS(*xd);
584 }
585 
586 void N_VInv_NrnParallelLD(N_Vector x, N_Vector z) {
587  long int i, N;
588  realtype *xd, *zd;
589 
590  N = NV_LOCLENGTH_P_LD(x);
591  xd = NV_DATA_P_LD(x);
592  zd = NV_DATA_P_LD(z);
593 
594  for (i = 0; i < N; i++)
595  *zd++ = ONE / (*xd++);
596 }
597 
598 void N_VAddConst_NrnParallelLD(N_Vector x, realtype b, N_Vector z) {
599  long int i, N;
600  realtype *xd, *zd;
601 
602  N = NV_LOCLENGTH_P_LD(x);
603  xd = NV_DATA_P_LD(x);
604  zd = NV_DATA_P_LD(z);
605 
606  for (i = 0; i < N; i++)
607  *zd++ = (*xd++) + b;
608 }
609 
610 realtype N_VDotProd_NrnParallelLD(N_Vector x, N_Vector y) {
611  long int i, N;
612  realtype sum = ZERO, *xd, *yd, gsum;
613  MPI_Comm comm;
614 
615  N = NV_LOCLENGTH_P_LD(x);
616  xd = NV_DATA_P_LD(x);
617  yd = NV_DATA_P_LD(y);
618  comm = NV_COMM_P_LD(x);
619 
620  for (i = 0; i < N; i++)
621  sum += xd[i] * yd[i];
622 
623  gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm);
624  return (gsum);
625 }
626 
627 realtype N_VMaxNorm_NrnParallelLD(N_Vector x) {
628  long int i, N;
629  realtype max, *xd, gmax;
630  MPI_Comm comm;
631 
632  N = NV_LOCLENGTH_P_LD(x);
633  xd = NV_DATA_P_LD(x);
634  comm = NV_COMM_P_LD(x);
635 
636  max = ZERO;
637 
638  for (i = 0; i < N; i++, xd++) {
639  if (ABS(*xd) > max)
640  max = ABS(*xd);
641  }
642 
643  gmax = VAllReduce_NrnParallelLD(max, 2, comm);
644  return (gmax);
645 }
646 
647 realtype N_VWrmsNorm_NrnParallelLD(N_Vector x, N_Vector w) {
648  long int i, N, N_global;
649  realtype prodi, *xd, *wd;
650  MPI_Comm comm;
651 
652  N = NV_LOCLENGTH_P_LD(x);
653  N_global = NV_GLOBLENGTH_P_LD(x);
654  xd = NV_DATA_P_LD(x);
655  wd = NV_DATA_P_LD(w);
656  comm = NV_COMM_P_LD(x);
657 
658  realtype sum{}, c{};
659  for (i = 0; i < N; i++) {
660  prodi = (*xd++) * (*wd++);
661  auto const y = prodi * prodi - c;
662  auto const t = sum + y;
663  c = (t - sum) - y;
664  sum = t;
665  }
666 
667  auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm);
668  return RSqrt(gsum / N_global);
669 }
670 
671 realtype N_VWrmsNormMask_NrnParallelLD(N_Vector x, N_Vector w, N_Vector id) {
672  long int i, N, N_global;
673  realtype prodi, *xd, *wd, *idd;
674  MPI_Comm comm;
675 
676  N = NV_LOCLENGTH_P_LD(x);
677  N_global = NV_GLOBLENGTH_P_LD(x);
678  xd = NV_DATA_P_LD(x);
679  wd = NV_DATA_P_LD(w);
680  idd = NV_DATA_P_LD(id);
681  comm = NV_COMM_P_LD(x);
682 
683  realtype sum{}, c{};
684  for (i = 0; i < N; i++) {
685  if (idd[i] > ZERO) {
686  prodi = xd[i] * wd[i];
687  auto const y = prodi * prodi - c;
688  auto const t = sum + y;
689  c = (t - sum) - y;
690  sum = t;
691  }
692  }
693 
694  auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm);
695  return RSqrt(gsum / N_global);
696 }
697 
698 realtype N_VMin_NrnParallelLD(N_Vector x) {
699  long int i, N;
700  realtype min, *xd, gmin;
701  MPI_Comm comm;
702 
703  N = NV_LOCLENGTH_P_LD(x);
704  comm = NV_COMM_P_LD(x);
705 
706  min = BIG_REAL;
707 
708  if (N > 0) {
709  xd = NV_DATA_P_LD(x);
710 
711  min = xd[0];
712 
713  xd++;
714  for (i = 1; i < N; i++, xd++) {
715  if ((*xd) < min)
716  min = *xd;
717  }
718  }
719 
720  gmin = VAllReduce_NrnParallelLD(min, 3, comm);
721  return (gmin);
722 }
723 
724 realtype N_VWL2Norm_NrnParallelLD(N_Vector x, N_Vector w) {
725  long int i, N;
726  realtype prodi, *xd, *wd;
727  MPI_Comm comm;
728 
729  N = NV_LOCLENGTH_P_LD(x);
730  xd = NV_DATA_P_LD(x);
731  wd = NV_DATA_P_LD(w);
732  comm = NV_COMM_P_LD(x);
733 
734  realtype sum{}, c{};
735  for (i = 0; i < N; i++) {
736  prodi = (*xd++) * (*wd++);
737  auto const y = prodi * prodi - c;
738  auto const t = sum + y;
739  c = (t - sum) - y;
740  sum = t;
741  }
742 
743  auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm);
744  return RSqrt(gsum);
745 }
746 
747 realtype N_VL1Norm_NrnParallelLD(N_Vector x) {
748  long int i, N;
749  realtype* xd;
750  MPI_Comm comm;
751 
752  N = NV_LOCLENGTH_P_LD(x);
753  xd = NV_DATA_P_LD(x);
754  comm = NV_COMM_P_LD(x);
755 
756  realtype sum{}, c{};
757  for (i = 0; i < N; i++, xd++) {
758  auto const y = ABS(*xd) - c;
759  auto const t = sum + y;
760  c = (t - sum) - y;
761  sum = t;
762  }
763 
764  auto const gsum = VAllReduce_long_NrnParallelLD(sum, 1, comm);
765  return gsum;
766 }
767 
768 void N_VCompare_NrnParallelLD(realtype c, N_Vector x, N_Vector z) {
769  long int i, N;
770  realtype *xd, *zd;
771 
772  N = NV_LOCLENGTH_P_LD(x);
773  xd = NV_DATA_P_LD(x);
774  zd = NV_DATA_P_LD(z);
775 
776  for (i = 0; i < N; i++, xd++, zd++) {
777  *zd = (ABS(*xd) >= c) ? ONE : ZERO;
778  }
779 }
780 
781 booleantype N_VInvTest_NrnParallelLD(N_Vector x, N_Vector z) {
782  long int i, N;
783  realtype *xd, *zd, val, gval;
784  MPI_Comm comm;
785 
786  N = NV_LOCLENGTH_P_LD(x);
787  xd = NV_DATA_P_LD(x);
788  zd = NV_DATA_P_LD(z);
789  comm = NV_COMM_P_LD(x);
790 
791  val = ONE;
792  for (i = 0; i < N; i++) {
793  if (*xd == ZERO)
794  val = ZERO;
795  else
796  *zd++ = ONE / (*xd++);
797  }
798 
799  gval = VAllReduce_NrnParallelLD(val, 3, comm);
800  if (gval == ZERO)
801  return (FALSE);
802  else
803  return (TRUE);
804 }
805 
806 booleantype N_VConstrMask_NrnParallelLD(N_Vector c, N_Vector x, N_Vector m) {
807  long int i, N;
808  booleantype test;
809  realtype *cd, *xd, *md;
810  MPI_Comm comm;
811 
812  N = NV_LOCLENGTH_P_LD(x);
813  xd = NV_DATA_P_LD(x);
814  cd = NV_DATA_P_LD(c);
815  md = NV_DATA_P_LD(m);
816  comm = NV_COMM_P_LD(x);
817 
818  test = TRUE;
819 
820  for (i = 0; i < N; i++, cd++, xd++, md++) {
821  *md = ZERO;
822  if (*cd == ZERO)
823  continue;
824  if (*cd > ONEPT5 || (*cd) < -ONEPT5) {
825  if ((*xd) * (*cd) <= ZERO) {
826  test = FALSE;
827  *md = ONE;
828  }
829  continue;
830  }
831  if ((*cd) > HALF || (*cd) < -HALF) {
832  if ((*xd) * (*cd) < ZERO) {
833  test = FALSE;
834  *md = ONE;
835  }
836  }
837  }
838 
839  return ((booleantype) VAllReduce_long_NrnParallelLD((realtype) test, 3, comm));
840 }
841 
842 realtype N_VMinQuotient_NrnParallelLD(N_Vector num, N_Vector denom) {
843  booleantype notEvenOnce;
844  long int i, N;
845  realtype *nd, *dd, min = 0.0;
846  MPI_Comm comm;
847 
848  N = NV_LOCLENGTH_P_LD(num);
849  nd = NV_DATA_P_LD(num);
850  dd = NV_DATA_P_LD(denom);
851  comm = NV_COMM_P_LD(num);
852 
853  notEvenOnce = TRUE;
854 
855  for (i = 0; i < N; i++, nd++, dd++) {
856  if (*dd == ZERO)
857  continue;
858  else {
859  if (notEvenOnce) {
860  min = *nd / *dd;
861  notEvenOnce = FALSE;
862  } else
863  min = MIN(min, (*nd) / (*dd));
864  }
865  }
866 
867  if (notEvenOnce || (N == 0))
868  min = BIG_REAL;
869 
870  return (VAllReduce_NrnParallelLD(min, 3, comm));
871 }
872 
873 /*
874  * -----------------------------------------------------------------
875  * private functions
876  * -----------------------------------------------------------------
877  */
878 
879 static realtype VAllReduce_NrnParallelLD(realtype d, int op, MPI_Comm comm) {
880  /*
881  * This function does a global reduction. The operation is
882  * sum if op = 1,
883  * max if op = 2,
884  * min if op = 3.
885  * The operation is over all processors in the communicator
886  */
887  realtype out = 0.0;
888  nrnmpi_dbl_allreduce_vec(&d, &out, 1, op);
889  return out;
890 }
891 
892 static realtype VAllReduce_long_NrnParallelLD(realtype d, int op, MPI_Comm comm) {
893  /*
894  * This function does a global reduction. The operation is
895  * sum if op = 1,
896  * max if op = 2,
897  * min if op = 3.
898  * The operation is over all processors in the communicator
899  */
900  assert(op == 1);
901  long double ld_in{d}, ld_out{};
902  nrnmpi_longdbl_allreduce_vec(&ld_in, &ld_out, 1, op);
903  return ld_out;
904 }
905 
906 static void VCopy_NrnParallelLD(N_Vector x, N_Vector z) {
907  long int i, N;
908  realtype *xd, *zd;
909 
910  N = NV_LOCLENGTH_P_LD(x);
911  xd = NV_DATA_P_LD(x);
912  zd = NV_DATA_P_LD(z);
913 
914  for (i = 0; i < N; i++)
915  *zd++ = *xd++;
916 }
917 
918 static void VSum_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z) {
919  long int i, N;
920  realtype *xd, *yd, *zd;
921 
922  N = NV_LOCLENGTH_P_LD(x);
923  xd = NV_DATA_P_LD(x);
924  yd = NV_DATA_P_LD(y);
925  zd = NV_DATA_P_LD(z);
926 
927  for (i = 0; i < N; i++)
928  *zd++ = (*xd++) + (*yd++);
929 }
930 
931 static void VDiff_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z) {
932  long int i, N;
933  realtype *xd, *yd, *zd;
934 
935  N = NV_LOCLENGTH_P_LD(x);
936  xd = NV_DATA_P_LD(x);
937  yd = NV_DATA_P_LD(y);
938  zd = NV_DATA_P_LD(z);
939 
940  for (i = 0; i < N; i++)
941  *zd++ = (*xd++) - (*yd++);
942 }
943 
944 static void VNeg_NrnParallelLD(N_Vector x, N_Vector z) {
945  long int i, N;
946  realtype *xd, *zd;
947 
948  N = NV_LOCLENGTH_P_LD(x);
949  xd = NV_DATA_P_LD(x);
950  zd = NV_DATA_P_LD(z);
951 
952  for (i = 0; i < N; i++)
953  *zd++ = -(*xd++);
954 }
955 
956 static void VScaleSum_NrnParallelLD(realtype c, N_Vector x, N_Vector y, N_Vector z) {
957  long int i, N;
958  realtype *xd, *yd, *zd;
959 
960  N = NV_LOCLENGTH_P_LD(x);
961  xd = NV_DATA_P_LD(x);
962  yd = NV_DATA_P_LD(y);
963  zd = NV_DATA_P_LD(z);
964 
965  for (i = 0; i < N; i++)
966  *zd++ = c * ((*xd++) + (*yd++));
967 }
968 
969 static void VScaleDiff_NrnParallelLD(realtype c, N_Vector x, N_Vector y, N_Vector z) {
970  long int i, N;
971  realtype *xd, *yd, *zd;
972 
973  N = NV_LOCLENGTH_P_LD(x);
974  xd = NV_DATA_P_LD(x);
975  yd = NV_DATA_P_LD(y);
976  zd = NV_DATA_P_LD(z);
977 
978  for (i = 0; i < N; i++)
979  *zd++ = c * ((*xd++) - (*yd++));
980 }
981 
982 static void VLin1_NrnParallelLD(realtype a, N_Vector x, N_Vector y, N_Vector z) {
983  long int i, N;
984  realtype *xd, *yd, *zd;
985 
986  N = NV_LOCLENGTH_P_LD(x);
987  xd = NV_DATA_P_LD(x);
988  yd = NV_DATA_P_LD(y);
989  zd = NV_DATA_P_LD(z);
990 
991  for (i = 0; i < N; i++)
992  *zd++ = a * (*xd++) + (*yd++);
993 }
994 
995 static void VLin2_NrnParallelLD(realtype a, N_Vector x, N_Vector y, N_Vector z) {
996  long int i, N;
997  realtype *xd, *yd, *zd;
998 
999  N = NV_LOCLENGTH_P_LD(x);
1000  xd = NV_DATA_P_LD(x);
1001  yd = NV_DATA_P_LD(y);
1002  zd = NV_DATA_P_LD(z);
1003 
1004  for (i = 0; i < N; i++)
1005  *zd++ = a * (*xd++) - (*yd++);
1006 }
1007 
1008 static void Vaxpy_NrnParallelLD(realtype a, N_Vector x, N_Vector y) {
1009  long int i, N;
1010  realtype *xd, *yd;
1011 
1012  N = NV_LOCLENGTH_P_LD(x);
1013  xd = NV_DATA_P_LD(x);
1014  yd = NV_DATA_P_LD(y);
1015 
1016  if (a == ONE) {
1017  for (i = 0; i < N; i++)
1018  *yd++ += (*xd++);
1019  return;
1020  }
1021 
1022  if (a == -ONE) {
1023  for (i = 0; i < N; i++)
1024  *yd++ -= (*xd++);
1025  return;
1026  }
1027 
1028  for (i = 0; i < N; i++)
1029  *yd++ += a * (*xd++);
1030 }
1031 
1032 static void VScaleBy_NrnParallelLD(realtype a, N_Vector x) {
1033  long int i, N;
1034  realtype* xd;
1035 
1036  N = NV_LOCLENGTH_P_LD(x);
1037  xd = NV_DATA_P_LD(x);
1038 
1039  for (i = 0; i < N; i++)
1040  *xd++ *= a;
1041 }
#define v
Definition: md1redef.h:11
#define data
Definition: md1redef.h:36
#define i
Definition: md1redef.h:19
#define MIN(a, b)
Definition: grids.h:32
#define TRUE
Definition: grids.h:22
#define FALSE
Definition: grids.h:23
static int c
Definition: hoc.cpp:169
#define assert(ex)
Definition: hocassrt.h:24
printf
Definition: extdef.h:5
int const size_t const size_t n
Definition: nrngsl.h:10
size_t j
static void VDiff_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z)
static realtype VAllReduce_NrnParallelLD(realtype d, int op, MPI_Comm comm)
realtype N_VWL2Norm_NrnParallelLD(N_Vector x, N_Vector w)
void N_VSetArrayPointer_NrnParallelLD(realtype *v_data, N_Vector v)
N_Vector N_VClone_NrnParallelLD(N_Vector w)
booleantype N_VInvTest_NrnParallelLD(N_Vector x, N_Vector z)
static void VSum_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z)
realtype N_VL1Norm_NrnParallelLD(N_Vector x)
void N_VProd_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z)
#define ONE
void N_VScale_NrnParallelLD(realtype c, N_Vector x, N_Vector z)
static void VCopy_NrnParallelLD(N_Vector x, N_Vector z)
N_Vector N_VCloneEmpty_NrnParallelLD(N_Vector w)
N_Vector N_VMake_NrnParallelLD(MPI_Comm comm, long int local_length, long int global_length, realtype *v_data)
int nrnmpi_numprocs
realtype N_VMin_NrnParallelLD(N_Vector x)
#define BAD_N
#define HALF
realtype N_VWrmsNormMask_NrnParallelLD(N_Vector x, N_Vector w, N_Vector id)
void N_VDiv_NrnParallelLD(N_Vector x, N_Vector y, N_Vector z)
void N_VSpace_NrnParallelLD(N_Vector v, long int *lrw, long int *liw)
N_Vector N_VNewEmpty_NrnParallelLD(MPI_Comm comm, long int local_length, long int global_length)
void N_VAddConst_NrnParallelLD(N_Vector x, realtype b, N_Vector z)
static void VScaleDiff_NrnParallelLD(realtype c, N_Vector x, N_Vector y, N_Vector z)
booleantype N_VConstrMask_NrnParallelLD(N_Vector c, N_Vector x, N_Vector m)
void N_VInv_NrnParallelLD(N_Vector x, N_Vector z)
void N_VAbs_NrnParallelLD(N_Vector x, N_Vector z)
static void VScaleBy_NrnParallelLD(realtype a, N_Vector x)
void N_VLinearSum_NrnParallelLD(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z)
void N_VConst_NrnParallelLD(realtype c, N_Vector z)
void N_VDestroyVectorArray_NrnParallelLD(N_Vector *vs, int count)
void N_VPrint_NrnParallelLD(N_Vector x)
static void VNeg_NrnParallelLD(N_Vector x, N_Vector z)
static void VLin1_NrnParallelLD(realtype a, N_Vector x, N_Vector y, N_Vector z)
void N_VDestroy_NrnParallelLD(N_Vector v)
realtype N_VMaxNorm_NrnParallelLD(N_Vector x)
N_Vector * N_VNewVectorArray_NrnParallelLD(int count, MPI_Comm comm, long int local_length, long int global_length)
realtype * N_VGetArrayPointer_NrnParallelLD(N_Vector v)
realtype N_VDotProd_NrnParallelLD(N_Vector x, N_Vector y)
realtype N_VMinQuotient_NrnParallelLD(N_Vector num, N_Vector denom)
#define ZERO
realtype N_VWrmsNorm_NrnParallelLD(N_Vector x, N_Vector w)
void N_VCompare_NrnParallelLD(realtype c, N_Vector x, N_Vector z)
N_Vector N_VNew_NrnParallelLD(MPI_Comm comm, long int local_length, long int global_length)
#define ONEPT5
static void VScaleSum_NrnParallelLD(realtype c, N_Vector x, N_Vector y, N_Vector z)
N_Vector * N_VNewVectorArrayEmpty_NrnParallelLD(int count, MPI_Comm comm, long int local_length, long int global_length)
static void VLin2_NrnParallelLD(realtype a, N_Vector x, N_Vector y, N_Vector z)
static realtype VAllReduce_long_NrnParallelLD(realtype d, int op, MPI_Comm comm)
static void Vaxpy_NrnParallelLD(realtype a, N_Vector x, N_Vector y)
#define NV_OWN_DATA_P_LD(v)
#define NV_COMM_P_LD(v)
struct _N_VectorContent_NrnParallelLD * N_VectorContent_NrnParallelLD
#define NV_DATA_P_LD(v)
#define NV_GLOBLENGTH_P_LD(v)
#define NV_LOCLENGTH_P_LD(v)
#define MPI_Comm
#define NULL
Definition: spdefs.h:105
#define ABS(a)
Definition: spdefs.h:119