xref: /petsc/src/ksp/pc/impls/tfs/xyt.c (revision bd1d2e58f8cbc36507210eb5c7ed44b6e0bd635f)
1 #define PETSCKSP_DLL
2 
3 /*************************************xyt.c************************************
4 Module Name: xyt
5 Module Info:
6 
7 author:  Henry M. Tufo III
8 e-mail:  hmt@asci.uchicago.edu
9 contact:
10 +--------------------------------+--------------------------------+
11 |MCS Division - Building 221     |Department of Computer Science  |
12 |Argonne National Laboratory     |Ryerson 152                     |
13 |9700 S. Cass Avenue             |The University of Chicago       |
14 |Argonne, IL  60439              |Chicago, IL  60637              |
15 |(630) 252-5354/5986 ph/fx       |(773) 702-6019/8487 ph/fx       |
16 +--------------------------------+--------------------------------+
17 
18 Last Modification: 3.20.01
19 **************************************xyt.c***********************************/
20 
21 
22 /*************************************xyt.c************************************
23 NOTES ON USAGE:
24 
25 **************************************xyt.c***********************************/
26 #include "src/ksp/pc/impls/tfs/tfs.h"
27 
28 #define LEFT  -1
29 #define RIGHT  1
30 #define BOTH   0
31 #define MAX_FORTRAN_HANDLES  10
32 
33 typedef struct xyt_solver_info {
34   int n, m, n_global, m_global;
35   int nnz, max_nnz, msg_buf_sz;
36   int *nsep, *lnsep, *fo, nfo, *stages;
37   int *xcol_sz, *xcol_indices;
38   PetscScalar **xcol_vals, *x, *solve_uu, *solve_w;
39   int *ycol_sz, *ycol_indices;
40   PetscScalar **ycol_vals, *y;
41   int nsolves;
42   PetscScalar tot_solve_time;
43 } xyt_info;
44 
45 
46 typedef struct matvec_info {
47   int n, m, n_global, m_global;
48   int *local2global;
49   gs_ADT gs_handle;
50   PetscErrorCode (*matvec)(struct matvec_info*,PetscScalar*,PetscScalar*);
51   void *grid_data;
52 } mv_info;
53 
54 struct xyt_CDT{
55   int id;
56   int ns;
57   int level;
58   xyt_info *info;
59   mv_info  *mvi;
60 };
61 
62 static int n_xyt=0;
63 static int n_xyt_handles=0;
64 
65 /* prototypes */
66 static void do_xyt_solve(xyt_ADT xyt_handle, PetscScalar *rhs);
67 static void check_init(void);
68 static void check_handle(xyt_ADT xyt_handle);
69 static void det_separators(xyt_ADT xyt_handle);
70 static void do_matvec(mv_info *A, PetscScalar *v, PetscScalar *u);
71 static int xyt_generate(xyt_ADT xyt_handle);
72 static int do_xyt_factor(xyt_ADT xyt_handle);
73 static mv_info *set_mvi(int *local2global, int n, int m, void *matvec, void *grid_data);
74 
75 
76 /*************************************xyt.c************************************
77 Function: XYT_new()
78 
79 Input :
80 Output:
81 Return:
82 Description:
83 **************************************xyt.c***********************************/
84 xyt_ADT
85 XYT_new(void)
86 {
87   xyt_ADT xyt_handle;
88 
89 
90 
91   /* rolling count on n_xyt ... pot. problem here */
92   n_xyt_handles++;
93   xyt_handle       = (xyt_ADT)malloc(sizeof(struct xyt_CDT));
94   xyt_handle->id   = ++n_xyt;
95   xyt_handle->info = NULL;
96   xyt_handle->mvi  = NULL;
97 
98   return(xyt_handle);
99 }
100 
101 
102 /*************************************xyt.c************************************
103 Function: XYT_factor()
104 
105 Input :
106 Output:
107 Return:
108 Description:
109 **************************************xyt.c***********************************/
110 int
111 XYT_factor(xyt_ADT xyt_handle, /* prev. allocated xyt  handle */
112 	   int *local2global,  /* global column mapping       */
113 	   int n,              /* local num rows              */
114 	   int m,              /* local num cols              */
115 	   void *matvec,       /* b_loc=A_local.x_loc         */
116 	   void *grid_data     /* grid data for matvec        */
117 	   )
118 {
119 
120   check_init();
121   check_handle(xyt_handle);
122 
123   /* only 2^k for now and all nodes participating */
124   if ((1<<(xyt_handle->level=i_log2_num_nodes))!=num_nodes)
125     {error_msg_fatal("only 2^k for now and MPI_COMM_WORLD!!! %d != %d\n",1<<i_log2_num_nodes,num_nodes);}
126 
127   /* space for X info */
128   xyt_handle->info = (xyt_info*)malloc(sizeof(xyt_info));
129 
130   /* set up matvec handles */
131   xyt_handle->mvi  = set_mvi(local2global, n, m, matvec, grid_data);
132 
133   /* matrix is assumed to be of full rank */
134   /* LATER we can reset to indicate rank def. */
135   xyt_handle->ns=0;
136 
137   /* determine separators and generate firing order - NB xyt info set here */
138   det_separators(xyt_handle);
139 
140   return(do_xyt_factor(xyt_handle));
141 }
142 
143 
144 /*************************************xyt.c************************************
145 Function: XYT_solve
146 
147 Input :
148 Output:
149 Return:
150 Description:
151 **************************************xyt.c***********************************/
152 int
153 XYT_solve(xyt_ADT xyt_handle, double *x, double *b)
154 {
155   check_init();
156   check_handle(xyt_handle);
157 
158   /* need to copy b into x? */
159   if (b)
160     {rvec_copy(x,b,xyt_handle->mvi->n);}
161   do_xyt_solve(xyt_handle,x);
162 
163   return(0);
164 }
165 
166 
167 /*************************************xyt.c************************************
168 Function: XYT_free()
169 
170 Input :
171 Output:
172 Return:
173 Description:
174 **************************************xyt.c***********************************/
175 int
176 XYT_free(xyt_ADT xyt_handle)
177 {
178   check_init();
179   check_handle(xyt_handle);
180   n_xyt_handles--;
181 
182   free(xyt_handle->info->nsep);
183   free(xyt_handle->info->lnsep);
184   free(xyt_handle->info->fo);
185   free(xyt_handle->info->stages);
186   free(xyt_handle->info->solve_uu);
187   free(xyt_handle->info->solve_w);
188   free(xyt_handle->info->x);
189   free(xyt_handle->info->xcol_vals);
190   free(xyt_handle->info->xcol_sz);
191   free(xyt_handle->info->xcol_indices);
192   free(xyt_handle->info->y);
193   free(xyt_handle->info->ycol_vals);
194   free(xyt_handle->info->ycol_sz);
195   free(xyt_handle->info->ycol_indices);
196   free(xyt_handle->info);
197   free(xyt_handle->mvi->local2global);
198    gs_free(xyt_handle->mvi->gs_handle);
199   free(xyt_handle->mvi);
200   free(xyt_handle);
201 
202 
203   /* if the check fails we nuke */
204   /* if NULL pointer passed to free we nuke */
205   /* if the calls to free fail that's not my problem */
206   return(0);
207 }
208 
209 
210 
211 /*************************************xyt.c************************************
212 Function:
213 
214 Input :
215 Output:
216 Return:
217 Description:
218 **************************************xyt.c***********************************/
219 int
220 XYT_stats(xyt_ADT xyt_handle)
221 {
222   int  op[] = {NON_UNIFORM,GL_MIN,GL_MAX,GL_ADD,GL_MIN,GL_MAX,GL_ADD,GL_MIN,GL_MAX,GL_ADD};
223   int fop[] = {NON_UNIFORM,GL_MIN,GL_MAX,GL_ADD};
224   int   vals[9],  work[9];
225   PetscScalar fvals[3], fwork[3];
226 
227 
228   check_init();
229   check_handle(xyt_handle);
230 
231   /* if factorization not done there are no stats */
232   if (!xyt_handle->info||!xyt_handle->mvi)
233     {
234       if (!my_id)
235 	{printf("XYT_stats() :: no stats available!\n");}
236       return 1;
237     }
238 
239   vals[0]=vals[1]=vals[2]=xyt_handle->info->nnz;
240   vals[3]=vals[4]=vals[5]=xyt_handle->mvi->n;
241   vals[6]=vals[7]=vals[8]=xyt_handle->info->msg_buf_sz;
242   giop(vals,work,sizeof(op)/sizeof(op[0])-1,op);
243 
244   fvals[0]=fvals[1]=fvals[2]
245     =xyt_handle->info->tot_solve_time/xyt_handle->info->nsolves++;
246   grop(fvals,fwork,sizeof(fop)/sizeof(fop[0])-1,fop);
247 
248   if (!my_id)
249     {
250       printf("%d :: min   xyt_nnz=%d\n",my_id,vals[0]);
251       printf("%d :: max   xyt_nnz=%d\n",my_id,vals[1]);
252       printf("%d :: avg   xyt_nnz=%g\n",my_id,1.0*vals[2]/num_nodes);
253       printf("%d :: tot   xyt_nnz=%d\n",my_id,vals[2]);
254       printf("%d :: xyt   C(2d)  =%g\n",my_id,vals[2]/(pow(1.0*vals[5],1.5)));
255       printf("%d :: xyt   C(3d)  =%g\n",my_id,vals[2]/(pow(1.0*vals[5],1.6667)));
256       printf("%d :: min   xyt_n  =%d\n",my_id,vals[3]);
257       printf("%d :: max   xyt_n  =%d\n",my_id,vals[4]);
258       printf("%d :: avg   xyt_n  =%g\n",my_id,1.0*vals[5]/num_nodes);
259       printf("%d :: tot   xyt_n  =%d\n",my_id,vals[5]);
260       printf("%d :: min   xyt_buf=%d\n",my_id,vals[6]);
261       printf("%d :: max   xyt_buf=%d\n",my_id,vals[7]);
262       printf("%d :: avg   xyt_buf=%g\n",my_id,1.0*vals[8]/num_nodes);
263       printf("%d :: min   xyt_slv=%g\n",my_id,fvals[0]);
264       printf("%d :: max   xyt_slv=%g\n",my_id,fvals[1]);
265       printf("%d :: avg   xyt_slv=%g\n",my_id,fvals[2]/num_nodes);
266     }
267 
268   return(0);
269 }
270 
271 
272 /*************************************xyt.c************************************
273 Function: do_xyt_factor
274 
275 Input :
276 Output:
277 Return:
278 Description: get A_local, local portion of global coarse matrix which
279 is a row dist. nxm matrix w/ n<m.
280    o my_ml holds address of ML struct associated w/A_local and coarse grid
281    o local2global holds global number of column i (i=0,...,m-1)
282    o local2global holds global number of row    i (i=0,...,n-1)
283    o mylocmatvec performs A_local . vec_local (note that gs is performed using
284    gs_init/gop).
285 
286 mylocmatvec = my_ml->Amat[grid_tag].matvec->external;
287 mylocmatvec (void :: void *data, double *in, double *out)
288 **************************************xyt.c***********************************/
289 static
290 int
291 do_xyt_factor(xyt_ADT xyt_handle)
292 {
293   int flag;
294 
295 
296   flag=xyt_generate(xyt_handle);
297   return(flag);
298 }
299 
300 
301 /*************************************xyt.c************************************
302 Function:
303 
304 Input :
305 Output:
306 Return:
307 Description:
308 **************************************xyt.c***********************************/
309 static
310 int
311 xyt_generate(xyt_ADT xyt_handle)
312 {
313   int i,j,k,idx;
314   int dim, col;
315   PetscScalar *u, *uu, *v, *z, *w, alpha, alpha_w;
316   int *segs;
317   int op[] = {GL_ADD,0};
318   int off, len;
319   PetscScalar *x_ptr, *y_ptr;
320   int *iptr, flag;
321   int start=0, end, work;
322   int op2[] = {GL_MIN,0};
323   gs_ADT gs_handle;
324   int *nsep, *lnsep, *fo;
325   int a_n=xyt_handle->mvi->n;
326   int a_m=xyt_handle->mvi->m;
327   int *a_local2global=xyt_handle->mvi->local2global;
328   int level;
329   int n, m;
330   int *xcol_sz, *xcol_indices, *stages;
331   PetscScalar **xcol_vals, *x;
332   int *ycol_sz, *ycol_indices;
333   PetscScalar **ycol_vals, *y;
334   int n_global;
335   int xt_nnz=0, xt_max_nnz=0;
336   int yt_nnz=0, yt_max_nnz=0;
337   int xt_zero_nnz  =0;
338   int xt_zero_nnz_0=0;
339   int yt_zero_nnz  =0;
340   int yt_zero_nnz_0=0;
341   PetscBLASInt i1 = 1;
342   PetscScalar dm1 = -1.0;
343 
344   n=xyt_handle->mvi->n;
345   nsep=xyt_handle->info->nsep;
346   lnsep=xyt_handle->info->lnsep;
347   fo=xyt_handle->info->fo;
348   end=lnsep[0];
349   level=xyt_handle->level;
350   gs_handle=xyt_handle->mvi->gs_handle;
351 
352   /* is there a null space? */
353   /* LATER add in ability to detect null space by checking alpha */
354   for (i=0, j=0; i<=level; i++)
355     {j+=nsep[i];}
356 
357   m = j-xyt_handle->ns;
358   if (m!=j)
359     {printf("xyt_generate() :: null space exists %d %d %d\n",m,j,xyt_handle->ns);}
360 
361   error_msg_warning("xyt_generate() :: X(%d,%d)\n",n,m);
362 
363   /* get and initialize storage for x local         */
364   /* note that x local is nxm and stored by columns */
365   xcol_sz = (int*) malloc(m*sizeof(PetscInt));
366   xcol_indices = (int*) malloc((2*m+1)*sizeof(int));
367   xcol_vals = (PetscScalar **) malloc(m*sizeof(PetscScalar *));
368   for (i=j=0; i<m; i++, j+=2)
369     {
370       xcol_indices[j]=xcol_indices[j+1]=xcol_sz[i]=-1;
371       xcol_vals[i] = NULL;
372     }
373   xcol_indices[j]=-1;
374 
375   /* get and initialize storage for y local         */
376   /* note that y local is nxm and stored by columns */
377   ycol_sz = (int*) malloc(m*sizeof(PetscInt));
378   ycol_indices = (int*) malloc((2*m+1)*sizeof(int));
379   ycol_vals = (PetscScalar **) malloc(m*sizeof(PetscScalar *));
380   for (i=j=0; i<m; i++, j+=2)
381     {
382       ycol_indices[j]=ycol_indices[j+1]=ycol_sz[i]=-1;
383       ycol_vals[i] = NULL;
384     }
385   ycol_indices[j]=-1;
386 
387   /* size of separators for each sub-hc working from bottom of tree to top */
388   /* this looks like nsep[]=segments */
389   stages = (int*) malloc((level+1)*sizeof(PetscInt));
390   segs   = (int*) malloc((level+1)*sizeof(PetscInt));
391   ivec_zero(stages,level+1);
392   ivec_copy(segs,nsep,level+1);
393   for (i=0; i<level; i++)
394     {segs[i+1] += segs[i];}
395   stages[0] = segs[0];
396 
397   /* temporary vectors  */
398   u  = (PetscScalar *) malloc(n*sizeof(PetscScalar));
399   z  = (PetscScalar *) malloc(n*sizeof(PetscScalar));
400   v  = (PetscScalar *) malloc(a_m*sizeof(PetscScalar));
401   uu = (PetscScalar *) malloc(m*sizeof(PetscScalar));
402   w  = (PetscScalar *) malloc(m*sizeof(PetscScalar));
403 
404   /* extra nnz due to replication of vertices across separators */
405   for (i=1, j=0; i<=level; i++)
406     {j+=nsep[i];}
407 
408   /* storage for sparse x values */
409   n_global = xyt_handle->info->n_global;
410   xt_max_nnz = yt_max_nnz = (int)(2.5*pow(1.0*n_global,1.6667) + j*n/2)/num_nodes;
411   x = (PetscScalar *) malloc(xt_max_nnz*sizeof(PetscScalar));
412   y = (PetscScalar *) malloc(yt_max_nnz*sizeof(PetscScalar));
413 
414   /* LATER - can embed next sep to fire in gs */
415   /* time to make the donuts - generate X factor */
416   for (dim=i=j=0;i<m;i++)
417     {
418       /* time to move to the next level? */
419       while (i==segs[dim])
420 	{
421 	  if (dim==level)
422 	    {error_msg_fatal("dim about to exceed level\n"); break;}
423 
424 	  stages[dim++]=i;
425 	  end+=lnsep[dim];
426 	}
427       stages[dim]=i;
428 
429       /* which column are we firing? */
430       /* i.e. set v_l */
431       /* use new seps and do global min across hc to determine which one to fire */
432       (start<end) ? (col=fo[start]) : (col=INT_MAX);
433       giop_hc(&col,&work,1,op2,dim);
434 
435       /* shouldn't need this */
436       if (col==INT_MAX)
437 	{
438 	  error_msg_warning("hey ... col==INT_MAX??\n");
439 	  continue;
440 	}
441 
442       /* do I own it? I should */
443       rvec_zero(v ,a_m);
444       if (col==fo[start])
445 	{
446 	  start++;
447 	  idx=ivec_linear_search(col, a_local2global, a_n);
448 	  if (idx!=-1)
449 	    {v[idx] = 1.0; j++;}
450 	  else
451 	    {error_msg_fatal("NOT FOUND!\n");}
452 	}
453       else
454 	{
455 	  idx=ivec_linear_search(col, a_local2global, a_m);
456 	  if (idx!=-1)
457 	    {v[idx] = 1.0;}
458 	}
459 
460       /* perform u = A.v_l */
461       rvec_zero(u,n);
462       do_matvec(xyt_handle->mvi,v,u);
463 
464       /* uu =  X^T.u_l (local portion) */
465       /* technically only need to zero out first i entries */
466       /* later turn this into an XYT_solve call ? */
467       rvec_zero(uu,m);
468       y_ptr=y;
469       iptr = ycol_indices;
470       for (k=0; k<i; k++)
471 	{
472 	  off = *iptr++;
473 	  len = *iptr++;
474 
475 	  uu[k] = BLASdot_(&len,u+off,&i1,y_ptr,&i1);
476 	  y_ptr+=len;
477 	}
478 
479       /* uu = X^T.u_l (comm portion) */
480       ssgl_radd  (uu, w, dim, stages);
481 
482       /* z = X.uu */
483       rvec_zero(z,n);
484       x_ptr=x;
485       iptr = xcol_indices;
486       for (k=0; k<i; k++)
487 	{
488 	  off = *iptr++;
489 	  len = *iptr++;
490 
491 	  BLASaxpy_(&len,&uu[k],x_ptr,&i1,z+off,&i1);
492 	  x_ptr+=len;
493 	}
494 
495       /* compute v_l = v_l - z */
496       rvec_zero(v+a_n,a_m-a_n);
497       BLASaxpy_(&n,&dm1,z,&i1,v,&i1);
498 
499       /* compute u_l = A.v_l */
500       if (a_n!=a_m)
501 	{gs_gop_hc(gs_handle,v,"+\0",dim);}
502       rvec_zero(u,n);
503      do_matvec(xyt_handle->mvi,v,u);
504 
505       /* compute sqrt(alpha) = sqrt(u_l^T.u_l) - local portion */
506       alpha = BLASdot_(&n,u,&i1,u,&i1);
507       /* compute sqrt(alpha) = sqrt(u_l^T.u_l) - comm portion */
508       grop_hc(&alpha, &alpha_w, 1, op, dim);
509 
510       alpha = (PetscScalar) sqrt((double)alpha);
511 
512       /* check for small alpha                             */
513       /* LATER use this to detect and determine null space */
514       if (fabs(alpha)<1.0e-14)
515 	{error_msg_fatal("bad alpha! %g\n",alpha);}
516 
517       /* compute v_l = v_l/sqrt(alpha) */
518       rvec_scale(v,1.0/alpha,n);
519       rvec_scale(u,1.0/alpha,n);
520 
521       /* add newly generated column, v_l, to X */
522       flag = 1;
523       off=len=0;
524       for (k=0; k<n; k++)
525 	{
526 	  if (v[k]!=0.0)
527 	    {
528 	      len=k;
529 	      if (flag)
530 		{off=k; flag=0;}
531 	    }
532 	}
533 
534       len -= (off-1);
535 
536       if (len>0)
537 	{
538 	  if ((xt_nnz+len)>xt_max_nnz)
539 	    {
540 	      error_msg_warning("increasing space for X by 2x!\n");
541 	      xt_max_nnz *= 2;
542 	      x_ptr = (PetscScalar *) malloc(xt_max_nnz*sizeof(PetscScalar));
543 	      rvec_copy(x_ptr,x,xt_nnz);
544 	      free(x);
545 	      x = x_ptr;
546 	      x_ptr+=xt_nnz;
547 	    }
548 	  xt_nnz += len;
549 	  rvec_copy(x_ptr,v+off,len);
550 
551           /* keep track of number of zeros */
552 	  if (dim)
553 	    {
554 	      for (k=0; k<len; k++)
555 		{
556 		  if (x_ptr[k]==0.0)
557 		    {xt_zero_nnz++;}
558 		}
559 	    }
560 	  else
561 	    {
562 	      for (k=0; k<len; k++)
563 		{
564 		  if (x_ptr[k]==0.0)
565 		    {xt_zero_nnz_0++;}
566 		}
567 	    }
568 	  xcol_indices[2*i] = off;
569 	  xcol_sz[i] = xcol_indices[2*i+1] = len;
570 	  xcol_vals[i] = x_ptr;
571 	}
572       else
573 	{
574 	  xcol_indices[2*i] = 0;
575 	  xcol_sz[i] = xcol_indices[2*i+1] = 0;
576 	  xcol_vals[i] = x_ptr;
577 	}
578 
579 
580       /* add newly generated column, u_l, to Y */
581       flag = 1;
582       off=len=0;
583       for (k=0; k<n; k++)
584 	{
585 	  if (u[k]!=0.0)
586 	    {
587 	      len=k;
588 	      if (flag)
589 		{off=k; flag=0;}
590 	    }
591 	}
592 
593       len -= (off-1);
594 
595       if (len>0)
596 	{
597 	  if ((yt_nnz+len)>yt_max_nnz)
598 	    {
599 	      error_msg_warning("increasing space for Y by 2x!\n");
600 	      yt_max_nnz *= 2;
601 	      y_ptr = (PetscScalar *) malloc(yt_max_nnz*sizeof(PetscScalar));
602 	      rvec_copy(y_ptr,y,yt_nnz);
603 	      free(y);
604 	      y = y_ptr;
605 	      y_ptr+=yt_nnz;
606 	    }
607 	  yt_nnz += len;
608 	  rvec_copy(y_ptr,u+off,len);
609 
610           /* keep track of number of zeros */
611 	  if (dim)
612 	    {
613 	      for (k=0; k<len; k++)
614 		{
615 		  if (y_ptr[k]==0.0)
616 		    {yt_zero_nnz++;}
617 		}
618 	    }
619 	  else
620 	    {
621 	      for (k=0; k<len; k++)
622 		{
623 		  if (y_ptr[k]==0.0)
624 		    {yt_zero_nnz_0++;}
625 		}
626 	    }
627 	  ycol_indices[2*i] = off;
628 	  ycol_sz[i] = ycol_indices[2*i+1] = len;
629 	  ycol_vals[i] = y_ptr;
630 	}
631       else
632 	{
633 	  ycol_indices[2*i] = 0;
634 	  ycol_sz[i] = ycol_indices[2*i+1] = 0;
635 	  ycol_vals[i] = y_ptr;
636 	}
637     }
638 
639   /* close off stages for execution phase */
640   while (dim!=level)
641     {
642       stages[dim++]=i;
643       error_msg_warning("disconnected!!! dim(%d)!=level(%d)\n",dim,level);
644     }
645   stages[dim]=i;
646 
647   xyt_handle->info->n=xyt_handle->mvi->n;
648   xyt_handle->info->m=m;
649   xyt_handle->info->nnz=xt_nnz + yt_nnz;
650   xyt_handle->info->max_nnz=xt_max_nnz + yt_max_nnz;
651   xyt_handle->info->msg_buf_sz=stages[level]-stages[0];
652   xyt_handle->info->solve_uu = (PetscScalar *) malloc(m*sizeof(PetscScalar));
653   xyt_handle->info->solve_w  = (PetscScalar *) malloc(m*sizeof(PetscScalar));
654   xyt_handle->info->x=x;
655   xyt_handle->info->xcol_vals=xcol_vals;
656   xyt_handle->info->xcol_sz=xcol_sz;
657   xyt_handle->info->xcol_indices=xcol_indices;
658   xyt_handle->info->stages=stages;
659   xyt_handle->info->y=y;
660   xyt_handle->info->ycol_vals=ycol_vals;
661   xyt_handle->info->ycol_sz=ycol_sz;
662   xyt_handle->info->ycol_indices=ycol_indices;
663 
664   free(segs);
665   free(u);
666   free(v);
667   free(uu);
668   free(z);
669   free(w);
670 
671   return(0);
672 }
673 
674 
675 /*************************************xyt.c************************************
676 Function:
677 
678 Input :
679 Output:
680 Return:
681 Description:
682 **************************************xyt.c***********************************/
683 static
684 void
685 do_xyt_solve(xyt_ADT xyt_handle,  PetscScalar *uc)
686 {
687   int off, len, *iptr;
688   int level       =xyt_handle->level;
689   int n           =xyt_handle->info->n;
690   int m           =xyt_handle->info->m;
691   int *stages     =xyt_handle->info->stages;
692   int *xcol_indices=xyt_handle->info->xcol_indices;
693   int *ycol_indices=xyt_handle->info->ycol_indices;
694    PetscScalar *x_ptr, *y_ptr, *uu_ptr;
695   PetscScalar *solve_uu=xyt_handle->info->solve_uu;
696   PetscScalar *solve_w =xyt_handle->info->solve_w;
697   PetscScalar *x       =xyt_handle->info->x;
698   PetscScalar *y       =xyt_handle->info->y;
699   PetscBLASInt i1 = 1;
700 
701 
702   uu_ptr=solve_uu;
703   rvec_zero(uu_ptr,m);
704 
705   /* x  = X.Y^T.b */
706   /* uu = Y^T.b */
707   for (y_ptr=y,iptr=ycol_indices; *iptr!=-1; y_ptr+=len)
708     {
709       off=*iptr++; len=*iptr++;
710       *uu_ptr++ = BLASdot_(&len,uc+off,&i1,y_ptr,&i1);
711     }
712 
713   /* comunication of beta */
714   uu_ptr=solve_uu;
715   if (level) {ssgl_radd(uu_ptr, solve_w, level, stages);}
716 
717   rvec_zero(uc,n);
718 
719   /* x = X.uu */
720   for (x_ptr=x,iptr=xcol_indices; *iptr!=-1; x_ptr+=len)
721     {
722       off=*iptr++; len=*iptr++;
723       BLASaxpy_(&len,uu_ptr++,x_ptr,&i1,uc+off,&i1);
724     }
725 
726 }
727 
728 
729 /*************************************Xyt.c************************************
730 Function: check_init
731 
732 Input :
733 Output:
734 Return:
735 Description:
736 **************************************xyt.c***********************************/
737 static
738 void
739 check_init(void)
740 {
741   comm_init();
742 
743 
744 }
745 
746 
747 /*************************************xyt.c************************************
748 Function: check_handle()
749 
750 Input :
751 Output:
752 Return:
753 Description:
754 **************************************xyt.c***********************************/
755 static
756 void
757 check_handle(xyt_ADT xyt_handle)
758 {
759   int vals[2], work[2], op[] = {NON_UNIFORM,GL_MIN,GL_MAX};
760 
761   if (xyt_handle==NULL)
762     {error_msg_fatal("check_handle() :: bad handle :: NULL %d\n",xyt_handle);}
763 
764   vals[0]=vals[1]=xyt_handle->id;
765   giop(vals,work,sizeof(op)/sizeof(op[0])-1,op);
766   if ((vals[0]!=vals[1])||(xyt_handle->id<=0))
767     {error_msg_fatal("check_handle() :: bad handle :: id mismatch min/max %d/%d %d\n",
768 		     vals[0],vals[1], xyt_handle->id);}
769 
770 }
771 
772 
773 /*************************************xyt.c************************************
774 Function: det_separators
775 
776 Input :
777 Output:
778 Return:
779 Description:
780   det_separators(xyt_handle, local2global, n, m, mylocmatvec, grid_data);
781 **************************************xyt.c***********************************/
782 static
783 void
784 det_separators(xyt_ADT xyt_handle)
785 {
786   int i, ct, id;
787   int mask, edge, *iptr;
788   int *dir, *used;
789   int sum[4], w[4];
790   PetscScalar rsum[4], rw[4];
791   int op[] = {GL_ADD,0};
792   PetscScalar *lhs, *rhs;
793   int *nsep, *lnsep, *fo, nfo=0;
794   gs_ADT gs_handle=xyt_handle->mvi->gs_handle;
795   int *local2global=xyt_handle->mvi->local2global;
796   int  n=xyt_handle->mvi->n;
797   int  m=xyt_handle->mvi->m;
798   int level=xyt_handle->level;
799   int shared=FALSE;
800 
801   dir  = (int*)malloc(sizeof(PetscInt)*(level+1));
802   nsep = (int*)malloc(sizeof(PetscInt)*(level+1));
803   lnsep= (int*)malloc(sizeof(PetscInt)*(level+1));
804   fo   = (int*)malloc(sizeof(PetscInt)*(n+1));
805   used = (int*)malloc(sizeof(PetscInt)*n);
806 
807   ivec_zero(dir  ,level+1);
808   ivec_zero(nsep ,level+1);
809   ivec_zero(lnsep,level+1);
810   ivec_set (fo   ,-1,n+1);
811   ivec_zero(used,n);
812 
813   lhs  = (double*)malloc(sizeof(PetscScalar)*m);
814   rhs  = (double*)malloc(sizeof(PetscScalar)*m);
815 
816   /* determine the # of unique dof */
817   rvec_zero(lhs,m);
818   rvec_set(lhs,1.0,n);
819   gs_gop_hc(gs_handle,lhs,"+\0",level);
820   error_msg_warning("done first gs_gop_hc\n");
821   rvec_zero(rsum,2);
822   for (ct=i=0;i<n;i++)
823     {
824       if (lhs[i]!=0.0)
825 	{rsum[0]+=1.0/lhs[i]; rsum[1]+=lhs[i];}
826 
827       if (lhs[i]!=1.0)
828 	{
829           shared=TRUE;
830         }
831     }
832 
833   grop_hc(rsum,rw,2,op,level);
834   rsum[0]+=0.1;
835   rsum[1]+=0.1;
836 
837   /*
838       if (!my_id)
839       {
840       printf("xyt n unique = %d (%g)\n",(int) rsum[0], rsum[0]);
841       printf("xyt n shared = %d (%g)\n",(int) rsum[1], rsum[1]);
842       }
843   */
844 
845   xyt_handle->info->n_global=xyt_handle->info->m_global=(int) rsum[0];
846   xyt_handle->mvi->n_global =xyt_handle->mvi->m_global =(int) rsum[0];
847 
848   /* determine separator sets top down */
849   if (shared)
850     {
851       /* solution is to do as in the symmetric shared case but then */
852       /* pick the sub-hc with the most free dofs and do a mat-vec   */
853       /* and pick up the responses on the other sub-hc from the     */
854       /* initial separator set obtained from the symm. shared case  */
855       error_msg_fatal("shared dof separator determination not ready ... see hmt!!!\n");
856       for (iptr=fo+n,id=my_id,mask=num_nodes>>1,edge=level;edge>0;edge--,mask>>=1)
857 	{
858 	  /* set rsh of hc, fire, and collect lhs responses */
859 	  (id<mask) ? rvec_zero(lhs,m) : rvec_set(lhs,1.0,m);
860 	  gs_gop_hc(gs_handle,lhs,"+\0",edge);
861 
862 	  /* set lsh of hc, fire, and collect rhs responses */
863 	  (id<mask) ? rvec_set(rhs,1.0,m) : rvec_zero(rhs,m);
864 	  gs_gop_hc(gs_handle,rhs,"+\0",edge);
865 
866 	  for (i=0;i<n;i++)
867 	    {
868 	      if (id< mask)
869 		{
870 		  if (lhs[i]!=0.0)
871 		    {lhs[i]=1.0;}
872 		}
873 	      if (id>=mask)
874 		{
875 		  if (rhs[i]!=0.0)
876 		    {rhs[i]=1.0;}
877 		}
878 	    }
879 
880 	  if (id< mask)
881 	    {gs_gop_hc(gs_handle,lhs,"+\0",edge-1);}
882 	  else
883 	    {gs_gop_hc(gs_handle,rhs,"+\0",edge-1);}
884 
885 	  /* count number of dofs I own that have signal and not in sep set */
886 	  rvec_zero(rsum,4);
887 	  for (ivec_zero(sum,4),ct=i=0;i<n;i++)
888 	    {
889 	      if (!used[i])
890 		{
891 		  /* number of unmarked dofs on node */
892 		  ct++;
893 		  /* number of dofs to be marked on lhs hc */
894 		  if (id< mask)
895 		    {
896 		      if (lhs[i]!=0.0)
897 			{sum[0]++; rsum[0]+=1.0/lhs[i];}
898 		    }
899 		  /* number of dofs to be marked on rhs hc */
900 		  if (id>=mask)
901 		    {
902 		      if (rhs[i]!=0.0)
903 			{sum[1]++; rsum[1]+=1.0/rhs[i];}
904 		    }
905 		}
906 	    }
907 
908 	  /* go for load balance - choose half with most unmarked dofs, bias LHS */
909 	  (id<mask) ? (sum[2]=ct) : (sum[3]=ct);
910 	  (id<mask) ? (rsum[2]=ct) : (rsum[3]=ct);
911 	  giop_hc(sum,w,4,op,edge);
912 	  grop_hc(rsum,rw,4,op,edge);
913 	  rsum[0]+=0.1; rsum[1]+=0.1; rsum[2]+=0.1; rsum[3]+=0.1;
914 
915 	  if (id<mask)
916 	    {
917 	      /* mark dofs I own that have signal and not in sep set */
918 	      for (ct=i=0;i<n;i++)
919 		{
920 		  if ((!used[i])&&(lhs[i]!=0.0))
921 		    {
922 		      ct++; nfo++;
923 
924 		      if (nfo>n)
925 			{error_msg_fatal("nfo about to exceed n\n");}
926 
927 		      *--iptr = local2global[i];
928 		      used[i]=edge;
929 		    }
930 		}
931 	      if (ct>1) {ivec_sort(iptr,ct);}
932 
933 	      lnsep[edge]=ct;
934 	      nsep[edge]=(int) rsum[0];
935 	      dir [edge]=LEFT;
936 	    }
937 
938 	  if (id>=mask)
939 	    {
940 	      /* mark dofs I own that have signal and not in sep set */
941 	      for (ct=i=0;i<n;i++)
942 		{
943 		  if ((!used[i])&&(rhs[i]!=0.0))
944 		    {
945 		      ct++; nfo++;
946 
947 		      if (nfo>n)
948 			{error_msg_fatal("nfo about to exceed n\n");}
949 
950 		      *--iptr = local2global[i];
951 		      used[i]=edge;
952 		    }
953 		}
954 	      if (ct>1) {ivec_sort(iptr,ct);}
955 
956 	      lnsep[edge]=ct;
957 	      nsep[edge]= (int) rsum[1];
958 	      dir [edge]=RIGHT;
959 	    }
960 
961 	  /* LATER or we can recur on these to order seps at this level */
962 	  /* do we need full set of separators for this?                */
963 
964 	  /* fold rhs hc into lower */
965 	  if (id>=mask)
966 	    {id-=mask;}
967 	}
968     }
969   else
970     {
971       for (iptr=fo+n,id=my_id,mask=num_nodes>>1,edge=level;edge>0;edge--,mask>>=1)
972 	{
973 	  /* set rsh of hc, fire, and collect lhs responses */
974 	  (id<mask) ? rvec_zero(lhs,m) : rvec_set(lhs,1.0,m);
975 	  gs_gop_hc(gs_handle,lhs,"+\0",edge);
976 
977 	  /* set lsh of hc, fire, and collect rhs responses */
978 	  (id<mask) ? rvec_set(rhs,1.0,m) : rvec_zero(rhs,m);
979 	  gs_gop_hc(gs_handle,rhs,"+\0",edge);
980 
981 	  /* count number of dofs I own that have signal and not in sep set */
982 	  for (ivec_zero(sum,4),ct=i=0;i<n;i++)
983 	    {
984 	      if (!used[i])
985 		{
986 		  /* number of unmarked dofs on node */
987 		  ct++;
988 		  /* number of dofs to be marked on lhs hc */
989 		  if ((id< mask)&&(lhs[i]!=0.0)) {sum[0]++;}
990 		  /* number of dofs to be marked on rhs hc */
991 		  if ((id>=mask)&&(rhs[i]!=0.0)) {sum[1]++;}
992 		}
993 	    }
994 
995 	  /* for the non-symmetric case we need separators of width 2 */
996 	  /* so take both sides */
997 	  (id<mask) ? (sum[2]=ct) : (sum[3]=ct);
998 	  giop_hc(sum,w,4,op,edge);
999 
1000 	  ct=0;
1001 	  if (id<mask)
1002 	    {
1003 	      /* mark dofs I own that have signal and not in sep set */
1004 	      for (i=0;i<n;i++)
1005 		{
1006 		  if ((!used[i])&&(lhs[i]!=0.0))
1007 		    {
1008 		      ct++; nfo++;
1009 		      *--iptr = local2global[i];
1010 		      used[i]=edge;
1011 		    }
1012 		}
1013 	      /* LSH hc summation of ct should be sum[0] */
1014 	    }
1015 	  else
1016 	    {
1017 	      /* mark dofs I own that have signal and not in sep set */
1018 	      for (i=0;i<n;i++)
1019 		{
1020 		  if ((!used[i])&&(rhs[i]!=0.0))
1021 		    {
1022 		      ct++; nfo++;
1023 		      *--iptr = local2global[i];
1024 		      used[i]=edge;
1025 		    }
1026 		}
1027 	      /* RSH hc summation of ct should be sum[1] */
1028 	    }
1029 
1030 	  if (ct>1) {ivec_sort(iptr,ct);}
1031 	  lnsep[edge]=ct;
1032 	  nsep[edge]=sum[0]+sum[1];
1033 	  dir [edge]=BOTH;
1034 
1035 	  /* LATER or we can recur on these to order seps at this level */
1036 	  /* do we need full set of separators for this?                */
1037 
1038 	  /* fold rhs hc into lower */
1039 	  if (id>=mask)
1040 	    {id-=mask;}
1041 	}
1042     }
1043 
1044   /* level 0 is on processor case - so mark the remainder */
1045   for (ct=i=0;i<n;i++)
1046     {
1047       if (!used[i])
1048 	{
1049 	  ct++; nfo++;
1050 	  *--iptr = local2global[i];
1051 	  used[i]=edge;
1052 	}
1053     }
1054   if (ct>1) {ivec_sort(iptr,ct);}
1055   lnsep[edge]=ct;
1056   nsep [edge]=ct;
1057   dir  [edge]=BOTH;
1058 
1059   xyt_handle->info->nsep=nsep;
1060   xyt_handle->info->lnsep=lnsep;
1061   xyt_handle->info->fo=fo;
1062   xyt_handle->info->nfo=nfo;
1063 
1064   free(dir);
1065   free(lhs);
1066   free(rhs);
1067   free(used);
1068 
1069 }
1070 
1071 
1072 /*************************************xyt.c************************************
1073 Function: set_mvi
1074 
1075 Input :
1076 Output:
1077 Return:
1078 Description:
1079 **************************************xyt.c***********************************/
1080 static
1081 mv_info *set_mvi(int *local2global, int n, int m, void *matvec, void *grid_data)
1082 {
1083   mv_info *mvi;
1084 
1085 
1086   mvi = (mv_info*)malloc(sizeof(mv_info));
1087   mvi->n=n;
1088   mvi->m=m;
1089   mvi->n_global=-1;
1090   mvi->m_global=-1;
1091   mvi->local2global=(int*)malloc((m+1)*sizeof(PetscInt));
1092   ivec_copy(mvi->local2global,local2global,m);
1093   mvi->local2global[m] = INT_MAX;
1094   mvi->matvec=(PetscErrorCode (*)(mv_info*,PetscScalar*,PetscScalar*))matvec;
1095   mvi->grid_data=grid_data;
1096 
1097   /* set xyt communication handle to perform restricted matvec */
1098   mvi->gs_handle = gs_init(local2global, m, num_nodes);
1099 
1100   return(mvi);
1101 }
1102 
1103 
1104 /*************************************xyt.c************************************
1105 Function: set_mvi
1106 
1107 Input :
1108 Output:
1109 Return:
1110 Description:
1111 
1112       computes u = A.v
1113       do_matvec(xyt_handle->mvi,v,u);
1114 **************************************xyt.c***********************************/
1115 static void do_matvec(mv_info *A, PetscScalar *v, PetscScalar *u)
1116 {
1117   A->matvec((mv_info*)A->grid_data,v,u);
1118 }
1119 
1120 
1121 
1122